SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00036 1 08-24-9412:55ALL DAVID ROZENBERG 3D Rotation Objects SWAG9408 Ü▐j╜ 61 ╓ π{ Here is a program to rotate any object in 3D. }ππ(********************************************************π * This program was written by David Rozenberg *π * *π * The program show how to convert a 3D point into a 2D *π * plane like the computer screen. So it will give you *π * the illusion of 3D shape. *π * *π * You can rotate it by the keyboard arrows, for nonstop*π * rotate press Shift+Arrow *π * *π * Please use the program as it is without changing it. *π * *π * Usage: *π * 3D FileName.Ext *π * *π * There are some files for example how to build them *π * the header " ; 3D by David Rozenberg " must be at the*π * beging of the file. *π * *π ********************************************************)ππProgram G3d;π{$E+,N+}πUsesπ Crt,Graph;ππTypeπ Coordinate = Array[1..7] of Real;π Point = Recordπ X,Y,Z : Real;π End;π LineRec = ^LineType;π LineType = Recordπ FPoint,TPoint : Point;π Color : Byte;π Next : LineRec;π End;πππVarπ FirstLine : LineRec;π Last : LineRec;ππProcedure Init;πVarπ GraphDriver,GraphMode,GraphError : Integer;ππBeginπ GraphDriver:=Detect;π initGraph(GraphDriver,GraphMode,'\turbo\tp'); { your BGI driver address }π GraphError:=GraphResult;π if GraphError<>GrOk then beginπ clrscr;π writeln('Error while turning to graphics mode.');π writeln;π halt(2);π end;πEnd;πππFunction DegTRad(Deg : Real) : real;πBeginπ DegTRad:=Deg/180*Pi;πEnd;ππProcedure ConvertPoint (P : Point;Var X,Y : Integer);πVarπ Dx,Dy : Real;ππBeginπ X:=GetMaxX Div 2;π Y:=GetMaxY Div 2;π Dx:=(P.Y)*cos(pi/6);π Dy:=-(P.Y)*Sin(Pi/6);π Dx:=Dx+(P.X)*Cos(pi/3);π Dy:=Dy+(P.X)*Sin(Pi/3);π Dy:=Dy-P.Z;π X:=X+Round(Dx);π Y:=Y+Round(Dy);πEnd;ππProcedure DrawLine(Lrec : LineRec);πVarπ Fx,Fy,Tx,Ty : Integer;ππBeginπ SetColor(Lrec^.Color);π ConvertPoint(LRec^.FPoint,Fx,Fy);π ConvertPoint(LRec^.TPoint,Tx,Ty);π Line(Fx,Fy,Tx,Ty);πEnd;ππProcedure ShowLines;πVarπ Lp : LineRec;ππBeginπ ClearDevice;π Lp:=FirstLine;π While Lp<>Nil do Beginπ DrawLine(Lp);π Lp:=Lp^.Next;π end;πEnd;ππProcedure Error(Err : Byte;S : String);πBeginπ Clrscr;π Writeln;π Case Err ofπ 1 : Writeln('File : ',S,' not found!');π 2 : Writeln(S,' isn''t a 3d file!');π 3 : Writeln('Error in line :',S);π 4 : Writeln('No file was indicated');π End;π Writeln;π Halt(Err);πEnd;ππProcedure AddLine(Coord : Coordinate);πVarπ Lp : LineRec;ππBeginπ New(Lp);π Lp^.Color:=Round(Coord[7]);π Lp^.FPoint.X:=Coord[1];π Lp^.FPoint.Y:=Coord[2];π Lp^.FPoint.Z:=Coord[3];π Lp^.TPoint.X:=Coord[4];π Lp^.TPoint.Y:=Coord[5];π Lp^.TPoint.Z:=Coord[6];π Lp^.Next:=Nil;π If Last=Nil then FirstLine:=Lp else Last^.Next:=Lp;π Last:=Lp;πend;ππProcedure LoadFile(Name : String);πVarπ F : Text;π Coord : Coordinate;π S,S1 : String;π I : Byte;π LineNum : Word;π Comma : Integer;ππBeginπ FirstLine:=Nil;π Last:=Nil;π Assign(F,Name);π {$I-}π Reset(f);π {$I+}π If IoResult<>0 then Error(1,Name);π Readln(F,S);π If S<>'; 3D by David Rozenberg' then Error(2,Name);π LineNum:=1;π While Not Eof(F) do Beginπ Inc(LineNum);π Readln(F,S);π while Pos(' ',S)<>0 do Delete(S,Pos(' ',S),1);π If (S<>'') and (S[1]<>';') then beginπ For I:=1 to 6 do Beginπ Comma:=Pos(',',S);π If Comma=0 then Beginπ Close(F);π Str(LineNum:4,S);π Error(3,S);π End;π S1:=Copy(S,1,Comma-1);π Delete(S,1,Comma);π Val(S1,Coord[i],Comma);π If Comma<>0 then Beginπ Close(F);π Str(LineNum:4,S);π Error(3,S);π End;π End;π Val(S,Coord[7],Comma);π If Comma<>0 then Beginπ Close(F);π Str(LineNum:4,S);π Error(3,S);π End;π AddLine(Coord);π End;π End;π Close(F);πEnd;ππProcedure RotateZ(Deg : Real);πVarπ Lp : LineRec;π Rad : Real;π Tx,Ty : Real;ππBeginπ Rad:=DegTRad(Deg);π Lp:=FirstLine;π While Lp<>Nil do Beginπ With Lp^.Fpoint Do Beginπ TX:=(X*Cos(Rad)-Y*Sin(Rad));π TY:=(X*Sin(Rad)+Y*Cos(Rad));π X:=Tx;π Y:=Ty;π End;π With Lp^.Tpoint Do Beginπ TX:=(X*Cos(Rad)-Y*Sin(Rad));π TY:=(X*Sin(Rad)+Y*Cos(Rad));π X:=Tx;π Y:=Ty;π End;π Lp:=Lp^.Next;π end;πEnd;ππProcedure RotateY(Deg : Real);πVarπ Lp : LineRec;π Rad : Real;π Tx,Tz : Real;ππBeginπ Rad:=DegTRad(Deg);π Lp:=FirstLine;π While Lp<>Nil do Beginπ With Lp^.Fpoint Do Beginπ TX:=(X*Cos(Rad)-Z*Sin(Rad));π TZ:=(X*Sin(Rad)+Z*Cos(Rad));π X:=Tx;π Z:=Tz;π End;π With Lp^.Tpoint Do Beginπ TX:=(X*Cos(Rad)-Z*Sin(Rad));π TZ:=(X*Sin(Rad)+Z*Cos(Rad));π X:=Tx;π Z:=Tz;π End;π Lp:=Lp^.Next;π end;πEnd;ππProcedure Rotate;πVarπ Ch : Char;ππBeginπ Repeatπ Repeatπ Ch:=Readkey;π If ch=#0 then Ch:=Readkey;π Until Ch in [#27,#72,#75,#77,#80,#50,#52,#54,#56];π Case ch ofπ #54 :Beginπ While Not keypressed do beginπ RotateZ(10);π ShowLines;π Delay(100);π End;π Ch:=Readkey;π If Ch=#0 then Ch:=ReadKey;π End;π #52:Beginπ While Not keypressed do beginπ RotateZ(-10);π ShowLines;π Delay(100);π End;π Ch:=Readkey;π If Ch=#0 then Ch:=ReadKey;π End;π #56:Beginπ While Not keypressed do beginπ RotateY(10);π ShowLines;π Delay(100);π End;π Ch:=Readkey;π If Ch=#0 then Ch:=ReadKey;π End;π #50:Beginπ While Not keypressed do beginπ RotateY(-10);π ShowLines;π Delay(100);π End;π Ch:=Readkey;π If Ch=#0 then Ch:=ReadKey;π End;π #72 : Beginπ RotateY(10);π ShowLines;π End;π #75 : Beginπ RotateZ(-10);π ShowLines;π End;π #77 : Beginπ RotateZ(10);π ShowLines;π End;π #80 : Beginπ RotateY(-10);π ShowLines;π End;π End;π Until Ch=#27;πEnd;ππBeginπ If ParamCount<1 then Error(4,'');π LoadFile(ParamStr(1));π Init;π ShowLines;π Rotate;π CloseGraph;π ClrScr;π Writeln;π Writeln('Thanks for using 3D');π Writeln;πEnd.ππThere is sample of some files that can be rotated:πcut out and save in specified file nameπCube.3D:ππ; 3D by David Rozenbergπ; Base of cubeπ-70,70,-70,70,70,-70,15π70,70,-70,70,-70,-70,15π70,-70,-70,-70,-70,-70,15π-70,-70,-70,-70,70,-70,15π; Top of cubeπ-70,70,70,70,70,70,15π70,70,70,70,-70,70,15π70,-70,70,-70,-70,70,15π-70,-70,70,-70,70,70,15π; Side of cubeπ-70,70,-70,-70,70,70,13π70,70,-70,70,70,70,13π70,-70,-70,70,-70,70,13π-70,-70,-70,-70,-70,70,13ππDavid.3D:ππ; 3D by David Rozenbergπ0,-120,45,0,-30,45,15π0,-60,45,0,-60,-45,15π; π0,-15,45,0,15,45,12π0,15,45,0,15,-45,12π;π0,30,45,0,120,45,11π0,90,45,0,90,-45,11π;π50,-45,-75,50,45,-75,10π50,45,-75,50,45,-165,10ππ 2 08-24-9413:26ALL JOHN HOWARD Bounce v1.1 SWAG9408 ░D p 61 ╓ (*π From: Christian Ramsvikπ Subj: bounce v1.0πOrigin: Hatlane Point #9 (2:211/10.9)ππHI! Got a bouncing procedure a while ago. It bounces a ball, and you canπincrease speed in X- and Y-axis by pressing the arrow keys. I'm sure you canπextract what you need from this one:πππ From: John Howard jhπ Subj: bounce v1.1πOrigin: Synergy (1:280/66)πUpgraded to vary the ball size with / and *. Compass directions use keypad inπnumlock mode or UIOJKNM, keys. The speed can be changed in each direction.πThe gravity effect can vary with + and - keys. Status report dialog box whenπeither space or 0 key pressed. Press 0 again will stop all motion. Pressπkeypad_5 will halt display and requires pressing ESCape key to continue. Aπperiod will reset the ball to default size.π*)ππprogram Bounce;πuses Crt, Graph;π{-$DEFINE solid}π{-$DEFINE bubble}π{ jhπconstπ MinBalls = 1;π MaxBalls = 2;π}πtypeπ TImage = recordπ XPos, {x} {horizontal position}π YPos : Integer; {y} {vertical position}π XSpeed, {dx} {actually a velocity}π YSpeed : Integer; {dy} {actually a velocity}π XAccel, {ddx} {jh unused acceleration}π YAccel : Integer; {ddy} {jh unused acceleration}ππ Radius : Byte; {Ball}π end;ππvarπ Ch : Char;π Gd, Gm : Integer;π Image : {array [MinBalls..MaxBalls] of} TImage; {jh}π FullSpeed, {jh}π HalfSpeed : Integer; { = FullSpeed div 2}π {BallNumber : byte;} {jh}ππ{ ******************* DRAW IMAGE ********************* }πprocedure DrawImage;πbeginπ SetColor( White );π{$IFDEF solid}π SetFillStyle( SolidFill, White );π{$ELSE}π SetFillStyle( HatchFill, White );π{$ENDIF}ππ with Image doπ beginπ{$IFDEF bubble}π Circle( XPos, YPos, Radius ); {jh Soap bubble}π{$ELSE}π PieSlice( XPos, YPos, 0, 360, Radius ); {jh Pattern ball}π{$ENDIF}π end;πend;ππ{ ******************* REMOVE IMAGE ******************** }πprocedure RemoveImage;πbeginπ SetColor( Black );π{$IFDEF solid}π SetFillStyle( SolidFill, Black );π{$ELSE}π SetFillStyle( HatchFill, Black );π{$ENDIF}ππ with Image doπ beginπ{$IFDEF bubble}π Circle( XPos, YPos, Radius ); {jh Soap bubble}π{$ELSE}π PieSlice( XPos, YPos, 0, 360, Radius ); {jh Pattern ball}π{$ENDIF}π end;πend;ππ{ ******************* UPDATE SPEED ******************** }πprocedure UpdateSpeed;ππ function IntToStr(I: Longint): String;π { convert any integer to a string }π var S: string[11];π beginπ Str(I,S);π IntToStr := S;π end;πbeginπ while KeyPressed doπ beginπ Ch := ReadKey;π Ch := Upcase(Ch);π case Ch of { Change speed with keypad numbers }π{jh Note: Keypad_5 causes a halt until escape key pressed}ππ '.': Image.Radius := 16; {Default}π '/': Image.Radius := Image.Radius shr 1; {Reduce}π '*': Image.Radius := Image.Radius shl 1; {Enlarge}π '+': beginπ Inc(FullSpeed);π HalfSpeed := FullSpeed div 2;π end;π '-': beginπ Dec(FullSpeed);π HalfSpeed := FullSpeed div 2;π end;π '8','I': Dec( Image.YSpeed, FullSpeed ); {N upwards}π '2','M': Inc( Image.YSpeed, FullSpeed ); {S downwards}π '4','J': Dec( Image.XSpeed, FullSpeed ); {W leftwards}π '6','K': Inc( Image.XSpeed, FullSpeed ); {E rightwards}π '0',' ': begin {Report statistics}π SetColor( White );π SetFillStyle( SolidFill, White );π Rectangle(8,8,8+160,8+56); {box}π SetViewPort(8,8,8+160,8+56, ClipOff); {dialog}π OutTextXY(2,2, '<ENTER> resumes');π OutTextXY(2,2+8, 'x = ' + IntToStr(Image.XPos));π OutTextXY(2,2+16, 'y = ' + IntToStr(Image.YPos));π OutTextXY(2,2+24, 'dx = '+ IntToStr(Image.XSpeed));π OutTextXY(2,2+32, 'dy = '+ IntToStr(Image.YSpeed));π OutTextXY(2,2+40, 'Full Speed = '+ IntToStr(FullSpeed));ππ Ch := ReadKey; {repeat until keypressed}π ClearViewPort;π SetViewPort(0,0,GetMaxX,GetMaxY, ClipOn); {window}π Rectangle(0,0,GetMaxX,GetMaxY); {border}π if (Ch = '0') then {Stop motion}π beginπ Image.XSpeed := 0;π Image.YSpeed := 0;π end;π end;π '7','U': begin {NW}π Dec(Image.XSpeed, HalfSpeed);π Dec(Image.YSpeed, HalfSpeed);π end;π '9','O': begin {NE}π Inc(Image.XSpeed, HalfSpeed);π Dec(Image.YSpeed, HalfSpeed);π end;π '1','N': begin {SW}π Dec(Image.XSpeed, HalfSpeed);π Inc(Image.YSpeed, HalfSpeed);π end;π '3',',': begin {SE}π Inc(Image.XSpeed, HalfSpeed);π Inc(Image.YSpeed, HalfSpeed);π end;ππ end; {case}π end;π Inc( Image.YSpeed, HalfSpeed ); { Gravitation } {jh Just so it can vary}πend;ππ{ ****************** UPDATE POSITIONS ****************** }πprocedure UpdatePositions;πbeginπ Inc( Image.XPos, Image.XSpeed );π Inc( Image.YPos, Image.YSpeed );πend;ππ{ ****************** CHECK COLLISION ******************* }πprocedure CheckCollision;πbeginπ with Image doπ beginπ if ( XPos - Radius ) <= 0 then { Hit left wall }π beginπ XPos := Radius +1;π XSpeed := -Trunc( XSpeed *0.9 );π end;ππ if ( XPos + Radius ) >= GetMaxX then { Hit right wall }π beginπ XPos := GetMaxX -Radius -1;π XSpeed := -Trunc( XSpeed *0.9 );π end;ππ if ( YPos -Radius ) <= 0 then { Hit roof }π beginπ YPos := Radius +1;π YSpeed := -Trunc( YSpeed *0.9 );π end;ππ if ( YPos +Radius ) >= GetMaxY then { Hit floor }π beginπ YPos := GetMaxY -Radius -1;π YSpeed := -Trunc( YSpeed *0.9 );π end;π end;πend;ππ{ ********************* PROGRAM ************************ }ππBEGINπ FullSpeed := 10;π HalfSpeed := FullSpeed div 2;π with Image doπ beginπ XPos := 30;π YPos := 30;π XSpeed := FullSpeed;π YSpeed := 0;π XAccel := 0; {jh unused}π YAccel := 10; {jh unused}ππ Radius := 16; {arbitrary}π end;ππ Gd := Detect;π InitGraph( Gd, Gm, ''); {BGI drivers in Current Work Dir (CWD)}π Gd := GraphResult;π if (Gd <> grOK) thenπ beginπ Gd := Detect;π InitGraph( Gd, Gm, '\TURBO\TP\'); {BGI drivers in default directory}π end;π Rectangle( 0, 0, GetMaxX, GetMaxY ); {border}π SetViewPort( 0, 0, GetMaxX, GetMaxY, ClipOn ); {window}ππ repeatπ DrawImage;π Delay( 30 ); {milliseconds Frame delay}π RemoveImage;ππ UpdateSpeed;π UpdatePositions;π CheckCollision;π until Ch = Chr( 27 );ππ CloseGraph;πEND.π 3 08-24-9413:27ALL LUIS MEZQUITA RAYA Cannon Ball Animation SWAG9408 ^¬fτ 20 ╓ {π JG> This coding works fine, I would like to make the ball travelπ JG> smoother. When it travels in the air, its kinda "Chunky"ππ JG> How could you make it so that the computer calculates the nextπ JG> point and make it travel the ball to that point one pixel at aπ JG> time? Cause with this structure, it kinda "Jumps there"ππ Try next code and tell me ...π}ππProgram FallingBall;ππ{ Written by Luis Mezquita Raya }ππ{$x+}ππuses Crt,π Graph;ππProcedure Init;πvar cg,mg:integer;πbeginπ cg:=Detect;π InitGraph(cg,mg,'\turbo\tp');πend;ππProcedure Wait(msk:byte); assembler;πasmπ mov dx,3dahπ@Loop1: in al,dxπ test al,mskπ jz @Loop1π@Loop2: in al,dxπ test al,mskπ jnz @Loop2πend;ππProcedure Calc;πvar angle,power,gravity,a1,a2,a3,y0,n:real;π size:word;π ball,mask,bkg:pointer;π x,y,ox,oy,pause:integer;πbeginππ ClearViewPort;ππ size:=ImageSize(0,0,20,20);π GetMem(ball,size);π GetMem(mask,size);π GetMem(bkg,size);ππ SetFillStyle(SolidFill,Yellow); { Draw a ball }π Circle(10,10,8);π FloodFill(10,10,White);π GetImage(0,0,20,20,ball^); { Get the ball }ππ SetFillStyle(SolidFill,White); { Draw ball's mask }π Bar(0,0,20,20);π SetFillStyle(SolidFill,Black);π SetColor(Black);π Circle(10,10,10);π FloodFill(10,10,Black);π GetImage(0,0,20,20,mask^); { Get the mask }ππ ClearViewPort; { Draw a background }π SetFillStyle(CloseDotFill,LightBlue);π Bar(0,0,GetMaxX,GetMaxY);ππ angle:=35; { Init vars }π power:=10;π gravity:=0.1;π y0:=200;π ox:=-1;π n:=0;ππ while n<80 do { Main loop }π beginπ a1:=cos(angle*pi/180)*power*n;π a2:=y0-sin(angle*pi/180)*power*n;π a3:=gravity*n*n;π x:=Round(a1);π y:=Round(a2+a3);π Wait(8); { Wait retrace }π for pause:=0 to 399 do Wait(1); { Wait scan line }π if ox<>-1 { Restore old background }π then PutImage(ox,oy,bkg^,CopyPut);π GetImage(x,y,x+20,y+20,bkg^); { Save background }π PutImage(x,y,mask^,AndPut); { Put mask }π PutImage(x,y,ball^,OrPut); { Put ball }π ox:=x;π oy:=y;π n:=n+0.2;π end;ππ FreeMem(ball,size);π FreeMem(mask,size);πend;πππbeginπ Init;π Calc;π ReadKey;π CloseGraph;πend.π 4 08-24-9413:28ALL JOHN HOWARD Coordinate Systems SWAG9408 Å∞┼W 70 ╓ {π -=> Quoting Sean Graham to All on 22 Jun 94 <=-π SG> some (efficient, I would hope) code in pascal that will allow me toπ SG> move in a 2D or 3D 'universe' (or more correctly, grid-system). Let meππ SG> Let's start out easy. For example, how would I write code to draw aπ SG> line on a 50x80 (yes, ascii chars) screen from pos A(10,5) to posπ SG> B(47,56)?π SG> Now imagine that my screen has magically grown a third dimention. Soπ SG> I now want to draw a line from pos A(47,34,7) to pos B(21,11,33). Howπ SG> would I write code to do that?ππ SG> Now picture this, I no longer have a screen, but a grid that worksπ SG> along the same principles as the screen did, except the points rangeπ SG> from -20 to +20 on (x,y,z). (That gives me a total of 68,921 (41^3)π SG> possible co-ordinates.)π SG> Pretend that Is a universe in space. I'm in a tiny escape pod andπ SG> must get from co-ordinate (-10,+05,+12) to co-ordinate (+07,+02,-11)ππIf you want to create an actual space, try :π}ππUNIT space;π{ Author: John Howard }π{πDefine a two-dimensional space representation which is used for Cartesian andπPolar coordinate systems. A three-dimensional space is for Spherical andπAzimuth-Elevation coordinate systems.π}π{ A vector is a one-dimensional array of real numbers. A matrix has twoπ dimensions m by n with m rows and n columns. Notice the row number alwaysπ comes first in the dimensions and the indices. Example square matrix A33 =π [ a11 a12 a13 ] or generally A[i, j]; i=rows, j=columns.π [ a21 a22 a23 ]π [ a31 a32 a33 ]π A matrix can be operated upon with appropriate column or row vectors.π}πINTERFACEπ{.$DEFINE D2} {remove period to use 2D}π{$IFNDEF D2}πconst N = 3; { Cardinality for Three_Vector}π M = 3; { Square matrix for invert routine}π{$ELSE}πconst N = 2; { Cardinality for Two_Vector}π M = 2; { Square matrix for invert routine}π{$ENDIF}π Size = M;πtypeπ Vector = array [1..N] of real; { 3D vector is the most common! }π Matrix = array [1..M, 1..N] of real; { 3x3 matrix is the most common! }ππ{Store all the components into a vector}π{$IFNDEF D2}π procedure Set_Value( var a: Vector; x_value, y_value, z_value: real);π{$ELSE}π procedure Set_Value( var a: Vector; x_value, y_value: real);π{$ENDIF}ππ{Retrieve the value of s from the ith element of a vector}π function Element( var a: Vector; i: integer): real;ππ{Retrieve the first element from a vector}π function X_Component( var a: Vector): real;ππ{Retrieve the second element from a vector}π function Y_Component( var a: Vector): real;ππ{Retrieve the third element from a vector}π{$IFNDEF D2}π function Z_Component( var a: Vector): real;π{$ENDIF}ππIMPLEMENTATIONππprocedure Set_Value; { Note: parameter list intentionally left off}πbeginπ a[1] := x_value;π a[2] := y_value;π{$IFNDEF D2}π a[3] := z_value;π{$ENDIF}πend;ππfunction Element( var a: Vector; i: integer): real;πbeginπ Element := a[i];πend;ππfunction X_Component( var a: Vector): real;πbeginπ X_Component := a[1];πend;ππfunction Y_Component( var a: Vector): real;πbeginπ Y_Component := a[2];πend;ππ{$IFNDEF D2}πfunction Z_Component( var a: Vector): real;πbeginπ Z_Component := a[3];πend;π{$ENDIF}πBEGINπEND.ππ(**********πIf you do not want to create an actual 3d space, just convert coordinates :ππYou could use a two dimensional X_Component and Y_Component calculation to getπyou to an approximate region based upon Z_Component. Example:ππFrom point A(x1,y1) to B(x2,y2) you travel a distance = sqrt(sqr(x2-x1) +π sqr(y2-y1)) at a slope of (y2-y1)/(x2-x1). That slope is called the Tangentπof the angle of inclination of the line AB.ππNow that you know where you are heading and how far away it is you can divideπthe total distance into sections say of unit length. That means a distance ofπ10 would have ten units. Every time your spaceship moves one unit in the knownπdirection you can reverse the calculation to find out where you are at. Whenπyou reach the final distance, you'd take approximations using the thirdπcomponent. This idea is simple but not very accurate in the interum space.ππYou can use the same idea but implement it with a proper coordinate conversion.π**********)ππUNIT coord;π{ Author: John Howard }π{ Original source: Jack Crenshaw, 1992 Embedded Systems Programming }π{ Space Conversion -- Angles are capitalized }π{ All axes are perpendicular to each other }πINTERFACEπconstπ Zero = 0.0;π One = 1.0;π TwoPi = Two * SYSTEM.Pi;π Pi_Over_Two = SYSTEM.Pi/Two;ππ{ 1 binary angular measure = 1 pirad = Pi radians = 180 degrees }π Degrees_Per_Radian = 180.0/SYSTEM.Pi;π Radians_Per_Degree = SYSTEM.Pi/180.0;ππ{ X-axis points east, y-axis north, and angle Theta is the heading measuredπ north of due east. If Theta is zero that corresponds to a line runningπ along the x-axis a radial distance of r.π}πProcedure To_Polar ( x, y: real; Var r, Theta: real);πProcedure From_Polar ( r, Theta: real; Var x, y: real);ππ{ X-axis points toward you, y-axis right, z-axis upward, angle Phi measuresπ directions in the horizontal (x-y plane) from the x-axis, and angle Thetaπ measures the direction in the vertical from the z-axis downward. If Thetaπ is zero that corresponds to a line pointed up the z-axis.π}πProcedure To_Spherical ( x, y, z: real; Var r, Phi, Theta: real);πProcedure From_Spherical ( r, Phi, Theta: real; Var x, y, z: real);ππ{ X-axis points east, y-axis north, z-axis upward, angle Phi corresponds to anπ azimuth measured clockwise from due north, and angle Theta is the elevationπ measured upwards from the horizon (x-y plane).π}πProcedure To_Azimuth_Elevation ( x, y, z: real; Var r, Phi, Theta: real);πProcedure From_Azimuth_Elevation ( r, Phi, Theta: real; Var x, y, z: real);ππFunction Sign ( x, y: real): real;πFunction Degrees ( A: real): real;πFunction Radians ( A: real): real;ππFunction Atan ( x: real): real; {ArcTangent}πFunction Atan2 ( s, c: real): real;ππIMPLEMENTATIONππ{ Convert from Cartesian to polar coordinates }πProcedure To_Polar ( x, y: real; Var r, Theta: real);πBeginπ r := Sqrt(Sqr(x) + Sqr(y));π Theta := Atan2(y, x);πEnd;ππ{ Convert from polar to Cartesian coordinates }πProcedure From_Polar ( r, Theta: real; Var x, y: real);πBeginπ x := r * Cos(Theta);π y := r * Sin(Theta);πEnd;ππ{ Convert from Cartesian to spherical polar coordinates }πProcedure To_Spherical ( x, y, z: real; Var r, Phi, Theta: real);πvar temp: real;πBeginπ To_Polar(x, y, temp, Phi);π To_Polar(z, temp, r, Theta);πEnd;ππ{ Convert from spherical polar to Cartesian coordinates }πProcedure From_Spherical ( r, Phi, Theta: real; Var x, y, z: real);πvar temp: real;πBeginπ From_Polar(r, Theta, z, temp);π From_Polar(temp, Phi, x, y);πEnd;ππ{ Convert from Cartesian to Az-El coordinates }πProcedure To_Azimuth_Elevation ( x, y, z: real; Var r, Phi, Theta: real);πvar temp: real;πBeginπ To_Polar(y, x, temp, Phi);π To_Polar(temp, z, r, Theta);πEnd;ππ{ Convert from Az-El to Cartesian coordinates }πProcedure From_Azimuth_Elevation ( r, Phi, Theta: real; Var x, y, z: real);πvar temp: real;πBeginπ From_Polar(r, Theta, temp, z);π From_Polar(temp, Phi, y, x);πEnd;ππ{ Returns Absolute value of x with Sign of y }πFunction Sign ( x, y: real): real;πBeginπ if y >= Zero thenπ Sign := Abs(x)π elseπ Sign := -Abs(x);πEnd;ππ{ Convert angle from radians to degrees }πFunction Degrees ( A: real): real;πBeginπ Degrees := Degrees_Per_Radian * A;πEnd;ππ{ Convert angle from degrees to radians }πFunction Radians ( A: real): real;πBeginπ Radians := Radians_Per_Degree * A;πEnd;ππ{ Inverse Trigonometric Tangent Function }πFunction Atan ( x: real): real;π{ Arctangent algorithm uses fifth-order rational fraction with optimizedπ coefficientsπ}π function _Atan ( x: real): real;π constπ a = 0.999999447;π b = 0.259455937;π c = 0.592716128;ππ var y: real;π beginπ y := x*x;π _Atan := a*x*( One + b*y) / ( One + c*y);π end;ππvar a, y: real;πBeginπ y := Abs(x);π if y <= One thenπ a := _Atan(y)π elseπ a := Pi_Over_Two - _Atan( One / y);π if x <= Zero thenπ a := -a;π Atan := a;πEnd;ππ{ Four-Quadrant Inverse Trigonometric Tangent Function }πFunction Atan2 ( s, c: real): real;πvar s1, c1, Theta: real;πBeginπ s1 := Abs(s);π c1 := Abs(c);π if c1 + s1 = Zero thenπ Theta := Zeroπ else if s1 <= c1 thenπ Theta := ArcTan(s1 / c1)π elseπ Theta := Pi_Over_Two - ArcTan(c1 / s1);π if c < Zero thenπ Theta := Pi - Theta;π Atan2 := Sign(Theta, s);πEnd;πBEGINπEND.π(*****END*****)π 5 08-24-9413:32ALL IAIN WHYTE DOT Matrix LED Effect SWAG9408 ╞≥I 218 ╓ unit dotmat; {written by Iain Whyte. (c) 1994 }ππ{ This unit generates a 'dot matrix' LED effect that is very effective. Ifπyou would like to use this code, all that I ask is that you mention itπin the credits somewhere, and let me know what you used it for. If you haveπany suggestions, or you want to talk to me or ask questions, I can beπcontacted at whytei@topaz.ucq.edu.au or ba022@cq-pan.cqu.edu.auπvia the Internet, or by snail-post :ππ Iain Whyteπ 141 Racecourse Roadπ Mt Morgan Q4714π Australia.ππor on the Rockhampton Computer Club BBS, via the programming, IBM/DOS, orπAMIGA conferences... RCC BBS: (079) 276200ππInstructions :ππSelf explanatary, really, there is a sample prog for using this unit at theπof this file..... }ππ{displays upto 10 characters at once, max string size (ATM) is 20 chars....}πππinterfaceππuses dos,crt,graph;ππππprocedure display_dotmat_screen(xpos,ypos:integer);πprocedure create_dotmat(inputstring:string);πprocedure straight_display;πprocedure left_right;πprocedure right_left;πprocedure top_bot;πprocedure bot_top;πprocedure italics;πprocedure random_fade_out;πprocedure random_fade_in;πprocedure fall_away;ππππimplementationπππtypeππletter_set=array[0..8,0..4] of integer;πdotmattype=array[0..8,0..119] of integer;ππconstπ pixelsize = 2; {size of each LED element i.e. 2 therfore LED is 2x2 pixels}π a : letter_set = ((0,1,1,1,0), {each letter is set up as a 5x9 array}π (1,0,0,0,1), {1 means LED is ON, 0 means LED OFF}π (1,0,0,0,1),π (1,0,0,0,1),π (1,1,1,1,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1));π b : letter_set = ((1,1,1,1,0),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,1,1,1,0),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,1,1,1,0));π c : letter_set = ((0,1,1,1,0),π (1,0,0,0,1),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,1),π (0,1,1,1,0));π d : letter_set = ((1,1,1,1,0),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,1,1,1,0));π e : letter_set = ((1,1,1,1,1),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,1,1,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,1,1,1,1));π f : letter_set = ((1,1,1,1,1),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,1,1,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0));π g : letter_set = ((0,1,1,1,0),π (1,0,0,0,1),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,1,1,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (0,1,1,1,0));π h : letter_set = ((1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,1,1,1,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1));π i : letter_set = ((0,1,1,1,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,1,1,1,0));π j : letter_set = ((0,0,1,1,1),π (0,0,0,1,0),π (0,0,0,1,0),π (0,0,0,1,0),π (0,0,0,1,0),π (1,0,0,1,0),π (1,0,0,1,0),π (1,0,0,1,0),π (0,1,1,0,0));π k : letter_set = ((1,0,0,0,1),π (1,0,0,1,0),π (1,0,1,0,0),π (1,1,0,0,0),π (1,1,0,0,0),π (1,1,0,0,0),π (1,0,1,0,0),π (1,0,0,1,0),π (1,0,0,0,1));π l : letter_set = ((1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,1,1,1,1));π m : letter_set = ((1,0,0,0,1),π (1,1,0,1,1),π (1,1,1,1,1),π (1,0,1,0,1),π (1,0,1,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1));π n : letter_set = ((1,0,0,0,1),π (1,1,0,0,1),π (1,1,0,0,1),π (1,0,1,0,1),π (1,0,1,0,1),π (1,0,1,0,1),π (1,0,0,1,1),π (1,0,0,1,1),π (1,0,0,0,1));π o : letter_set =((0,1,1,1,0),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (0,1,1,1,0));π p : letter_set =((1,1,1,1,0),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,1,1,1,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0));π q : letter_set =((0,1,1,1,0),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,1,0,1),π (1,0,0,1,1),π (0,1,1,1,1));π r : letter_set =((1,1,1,1,0),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,1,1,1,0),π (1,1,0,0,0),π (1,0,1,0,0),π (1,0,0,1,0),π (1,0,0,0,1));π s : letter_set =((0,1,1,1,0),π (1,0,0,0,1),π (1,0,0,0,0),π (1,0,0,0,0),π (0,1,1,1,0),π (0,0,0,0,1),π (0,0,0,0,1),π (1,0,0,0,1),π (0,1,1,1,0));π t : letter_set =((1,1,1,1,1),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0));π u : letter_set =((1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (0,1,1,1,0));π v : letter_set =((1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (0,1,0,1,0),π (0,1,0,1,0),π (0,0,1,0,0));π w : letter_set =((1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,1,0,1),π (1,0,1,0,1),π (0,1,1,1,0),π (0,1,0,1,0));π x : letter_set =((1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (0,1,0,1,0),π (0,0,1,0,0),π (0,1,0,1,0),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1));π y : letter_set =((1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (0,1,0,1,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0));π z : letter_set =((1,1,1,1,1),π (0,0,0,0,1),π (0,0,0,0,1),π (0,0,0,1,0),π (0,0,1,0,0),π (0,1,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,1,1,1,1));π exc : letter_set =((0,0,1,0,0),π (0,1,1,1,0),π (0,1,1,1,0),π (0,1,1,1,0),π (0,1,1,1,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,0,0,0),π (0,0,1,0,0));π andm : letter_set =((0,0,1,1,0),π (0,1,0,0,1),π (0,0,1,1,0),π (0,1,1,1,0),π (1,0,0,1,0),π (1,0,0,0,1),π (1,0,0,1,1),π (1,0,0,1,0),π (0,1,1,0,1));π hat : letter_set =((0,1,0,1,0),π (0,1,0,1,0),π (1,1,1,1,1),π (0,1,0,1,0),π (0,1,0,1,0),π (1,1,1,1,1),π (0,1,0,1,0),π (0,1,0,1,0),π (0,1,0,1,0));π com : letter_set =((0,0,0,0,0),π (0,0,0,0,0),π (0,0,0,0,0),π (0,0,0,0,0),π (0,0,0,0,0),π (0,0,1,1,0),π (0,0,1,1,0),π (0,0,1,0,0),π (0,1,1,0,0));π ast : letter_set=((0,0,0,0,0),π (1,0,1,0,1),π (0,1,1,1,0),π (0,0,1,0,0),π (1,1,1,1,1),π (0,0,1,0,0),π (0,1,1,1,0),π (1,0,1,0,1),π (0,0,0,0,0));π la : letter_set =((0,0,0,0,1),π (0,0,0,1,0),π (0,0,1,0,0),π (0,1,0,0,0),π (1,0,0,0,0),π (0,1,0,0,0),π (0,0,1,0,0),π (0,0,0,1,0),π (0,0,0,0,1));π ra : letter_set =((1,0,0,0,0),π (0,1,0,0,0),π (0,0,1,0,0),π (0,0,0,1,0),π (0,0,0,0,1),π (0,0,0,1,0),π (0,0,1,0,0),π (0,1,0,0,0),π (1,0,0,0,0));π one :letter_set =((0,0,1,0,0),π (0,1,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,1,1,1,0));π two : letter_set=((0,1,1,1,0),π (1,0,0,0,1),π (0,0,0,0,1),π (0,0,0,1,0),π (0,0,1,0,0),π (0,1,0,0,0),π (1,0,0,0,0),π (1,0,0,0,0),π (1,1,1,1,1));π thr: letter_set =((0,1,1,1,0),π (1,0,0,0,1),π (0,0,0,0,1),π (0,0,0,0,1),π (0,0,1,1,0),π (0,0,0,0,1),π (0,0,0,0,1),π (1,0,0,0,1),π (0,1,1,1,0));π four:letter_set =((1,0,0,0,0),π (1,0,0,0,0),π (1,0,0,1,0),π (1,0,0,1,0),π (1,0,0,1,0),π (1,0,0,1,0),π (1,1,1,1,1),π (0,0,0,1,0),π (0,0,0,1,0));π five:letter_set =((1,1,1,1,1),π (1,0,0,0,0),π (1,0,0,0,0),π (1,1,1,1,0),π (1,0,0,0,1),π (0,0,0,0,1),π (0,0,0,0,1),π (1,0,0,0,1),π (0,1,1,1,0));π six :letter_set =((0,1,1,1,0),π (1,0,0,0,1),π (1,0,0,0,0),π (1,1,1,1,0),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (0,1,1,1,0));π sev :letter_set =((1,1,1,1,1),π (1,0,0,0,1),π (0,0,0,0,1),π (0,0,0,1,0),π (0,0,0,1,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,1,0,0,0),π (0,1,0,0,0));π eight:letter_set =((0,1,1,1,0),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (0,1,1,1,0),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (0,1,1,1,0));π nine : letter_set =((0,1,1,1,0),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (1,0,0,0,1),π (0,1,1,1,1),π (0,0,0,0,1),π (1,0,0,0,1),π (0,1,1,1,0));π zer : letter_set =((0,1,1,1,0),π (1,0,0,1,1),π (1,0,0,1,1),π (1,0,1,0,1),π (1,0,1,0,1),π (1,0,1,0,1),π (1,1,0,0,1),π (1,1,0,0,1),π (0,1,1,1,0));ππ smil :letter_set =((0,1,1,1,0),π (1,1,1,1,1),π (1,0,1,0,1),π (1,1,1,1,1),π (1,1,0,1,1),π (1,1,1,1,1),π (1,0,0,0,1),π (1,1,0,1,1),π (0,1,1,1,0));π dol : letter_set =((0,0,1,0,0),π (0,1,1,1,0),π (1,0,1,0,1),π (1,0,1,0,0),π (0,1,1,1,0),π (0,0,1,0,1),π (1,0,1,0,1),π (0,1,1,1,0),π (0,0,1,0,0));π copyr: letter_set =((0,1,1,1,0),π (1,0,0,0,1),π (1,0,1,0,1),π (1,1,0,1,1),π (1,1,0,0,1),π (1,1,0,1,1),π (1,0,1,0,1),π (1,0,0,0,1),π (0,1,1,1,0));π lb: letter_set =((0,0,0,1,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,1,0,0,0),π (0,1,0,0,0),π (0,1,0,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,0,1,0));π rb: letter_set =((0,1,0,0,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,0,1,0),π (0,0,0,1,0),π (0,0,0,1,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,1,0,0,0));π quest: letter_set =((0,1,1,1,0),π (1,0,0,0,1),π (0,0,0,0,1),π (0,0,0,1,0),π (0,0,0,1,0),π (0,0,1,0,0),π (0,0,1,0,0),π (0,0,0,0,0),π (0,0,1,0,0));πππvarπ letters:array[' '..'z']of letter_set;π outchars:array[0..19]of char;π mainxpos,mainypos:integer;π dotmatarray:dotmattype;π dotmatarraymove,dotmatempty:dotmattype;π counth,countv,lettercount:integer;π count,count2,countmove,countloop:integer;ππprocedure setup_chars;ππbeginπ letters['a']:=a;π letters['b']:=b;π letters['c']:=c;π letters['d']:=d;π letters['e']:=e;π letters['f']:=f;π letters['g']:=g;π letters['h']:=h;π letters['i']:=i;π letters['j']:=j;π letters['k']:=k;π letters['l']:=l;π letters['m']:=m;π letters['n']:=n;π letters['o']:=o;π letters['p']:=p;π letters['q']:=q;π letters['r']:=r;π letters['s']:=s;π letters['t']:=t;π letters['u']:=u;π letters['v']:=v;π letters['w']:=w;π letters['x']:=x;π letters['y']:=y;π letters['z']:=z;π letters['!']:=exc;π letters['&']:=andm;π letters['#']:=hat;π letters[',']:=com;π letters['*']:=ast;π letters['<']:=la;π letters['>']:=ra;π letters['1']:=one;π letters['2']:=two;π letters['3']:=thr;π letters['4']:=four;π letters['5']:=five;π letters['6']:=six;π letters['7']:=sev;π letters['8']:=eight;π letters['9']:=nine;π letters['0']:=zer;π letters['^']:=smil;π letters['$']:=dol;π letters['@']:=copyr;π letters['(']:=lb;π letters[')']:=rb;π letters['?']:=quest;πend;ππprocedure display_dotmat_screen(xpos,ypos:integer);ππvar countx,county:integer;ππbeginπ mainxpos:=xpos;π mainypos:=ypos;π setfillstyle(1,8);π for countx:=0 to 59 doπ beginπ for county:=-1 to 9 doπ beginπ bar((xpos+(countx*(pixelsize+1))),(ypos+(county*(pixelsize+1))),π ((xpos+(countx*(pixelsize+1)))+(pixelsize-1)),((ypos+(county*(pixelsize+1)))+(pixelsize-1)));ππ end;π end;πend;πππprocedure convertstring_to_chars(instr:string);ππvar count:integer;π dummys:string[1];π strcount:char;ππbeginπ for count:=1 to 20 doπ beginππ dummys:=copy(instr,count,1);π for strcount:=' ' to 'z' doπ beginπ if dummys = strcount then outchars[count-1]:=strcount;π end;π end;πend;πππprocedure create_dotmat(inputstring:string);ππbeginπ for countv:=0 to 8 doπ for counth:=0 to 119 doπ dotmatempty[countv,counth]:=0;ππ setup_chars;π convertstring_to_chars(inputstring);ππ for lettercount:=0 to 19 do {make array of dots from letter data}π beginππ for countv:=0 to 8 doπ beginππ for counth :=(lettercount*6) to ((lettercount*6)+6) doπ beginπ if counth<120 thenπ beginπ dotmatarray[countv,counth]:=letters[outchars[lettercount],countv,(counth-lettercount*6)];π if (counth-lettercount*6) > 4 then dotmatarray[countv,counth]:=0;π end;π end;π end;π end;ππππend;πππprocedure gen_display;ππbeginππ for counth:=0 to 59 doπ beginπ for countv:=0 to 8 doπ beginπ if (counth < 2) or (counth > 57) then setfillstyle(1,2)π else setfillstyle(1,10);π if dotmatarraymove[countv,counth] = 1 thenπ beginπ bar((mainxpos+(counth*(pixelsize+1))),(mainypos+(countv*(pixelsize+1))),π ((mainxpos+(counth*(pixelsize+1)))+(pixelsize-1)),((mainypos+(countv*(pixelsize+1)))+(pixelsize-1)));π end;π setfillstyle(1,8);π if dotmatarraymove[countv,counth] = 0 thenπ beginπ bar((mainxpos+(counth*(pixelsize+1))),(mainypos+(countv*(pixelsize+1))),π ((mainxpos+(counth*(pixelsize+1)))+(pixelsize-1)),((mainypos+(countv*(pixelsize+1)))+(pixelsize-1)));π end;π end;π end;ππend;πππprocedure straight_display;ππbeginπ dotmatarraymove:=dotmatarray;π gen_display;πend;ππππprocedure left_right;πbeginππ for count2:=0 to 119 doπ beginπ for count:=0 to 59 doπ beginπ countmove:=count+count2;π if countmove>119 then countmove:=countmove-120;π for countloop:=0 to 8 do dotmatarraymove[countloop,count]:=dotmatarray[countloop,countmove];ππ end;π gen_display;π delay(5);π end;πend;πππprocedure right_left;πbeginππ for count2:=119 downto 0 doπ beginππ for count:=0 to 59 doπ beginπ countmove:=count+count2;π if countmove>119 then countmove:=countmove-120;π for countloop:= 0 to 8 do dotmatarraymove[countloop,count]:=dotmatarray[countloop,countmove];ππ end;ππ gen_display;π delay(5);π end;πend;πππprocedure top_bot;πbeginπ dotmatarraymove:=dotmatempty;π for count2:=-9 to 9 doπ beginππ for count:=0 to 8 doπ beginπ countmove:=count+count2;π if countmove>8 then for countloop:=0 to 119 do dotmatarraymove[count,countloop]:=0π else if countmove<0 then for countloop:=0 to 119 do dotmatarraymove[count,countloop]:=0π else for countloop:=0 to 119 do dotmatarraymove[count,countloop]:=dotmatarray[countmove,countloop];ππ end;ππ gen_display;π delay(50);π end;πend;πππprocedure bot_top;πbeginπ for count2:=9 downto -9 doπ beginππ for count:=0 to 8 doπ beginπ countmove:=count+count2;π if countmove>8 then for countloop:=0 to 119 do dotmatarraymove[count,countloop]:=0π else if countmove<0 then for countloop:=0 to 119 do dotmatarraymove[count,countloop]:=0π else for countloop:=0 to 119 do dotmatarraymove[count,countloop]:=dotmatarray[countmove,countloop];ππππ end;ππ gen_display;π delay(50);π end;πππend;ππprocedure italics;πbeginπ for count:=0 to 8 doπ beginπ for count2:=0 to 119 doπ beginπ if (count mod 2) = 0 thenπ beginπ dotmatarraymove[count,count2]:=dotmatarray[count,count2+(count div 2)];π end elseπ dotmatarraymove[count,count2]:=dotmatarray[count,count2+((count-1) div 2)];π end;π end;π dotmatarray:=dotmatarraymove;πend;ππππprocedure random_fade_out;ππvarπv,h,rnd,countdots:integer;ππbeginπ randomize;π dotmatarraymove:=dotmatarray;π countdots:=0;π for v:=0 to 8 doπ beginπ for h:=0 to 119 doπ beginπ if dotmatarraymove[v,h]=1 thenππ countdots:=countdots+1;π end;π end;π repeatπ for v:=0 to 8 doπ beginπ for h:=0 to 119 doπ beginπ if dotmatarraymove[v,h]=1 thenπ beginπ rnd:=random(5);π if rnd = 1 thenπ beginπ countdots:=countdots-1;π dotmatarraymove[v,h]:=0;π end;π end;π end;π end;ππ gen_display;π until countdots<=0;ππend;πππprocedure random_fade_in;πvarπv,h,rnd,countdots:integer;πbeginπ randomize;π dotmatarraymove:=dotmatempty;π countdots:=0;π for v:=0 to 8 doπ beginπ for h:=0 to 119 doπ beginπ if dotmatarray[v,h]=1 thenππ countdots:=countdots+1;π end;π end;π repeatπ for v:=0 to 8 doπ beginπ for h:=0 to 119 doπ beginπ if (dotmatarray[v,h]=1)and (dotmatarraymove[v,h]=0) thenπ beginπ rnd:=random(5);π if rnd = 1 thenπ beginπ countdots:=countdots-1;π dotmatarraymove[v,h]:=1;π end;π end;π end;π end;ππ gen_display;π until countdots<=0;ππend;ππprocedure fall_away;πbeginπ dotmatarraymove:=dotmatarray;π for count:=8 downto 0 doπ beginπ count2:=count;π repeatπ for countloop:=0 to 119 doπ beginπ if count2=count thenπ beginπ dotmatarraymove[count2,countloop]:=dotmatarray[count,countloop];π endπ elseπ beginπ dotmatarraymove[count2,countloop]:=dotmatarray[count,countloop];π dotmatarraymove[count2-1,countloop]:=0;π end;π end;π gen_display;π delay(5);π count2:=count2+1;π until count2=10;ππ end;πend;πππend.ππ{------------------------------- DEMO ----------------------------------}πprogram test_dotmat_unit;ππuses dos,crt,graph,dotmat;ππππvarπ in1,in2:integer;πππbegin {12345678901234567890} {length guide}ππ initgraph(in1,in2,'c:\bp\bgi'); {initialise 640x480x16c mode bgi}π cleardevice;πππ display_dotmat_screen(50,50); {set_up, display blank LED matrix}ππ create_dotmat('this is a demo ! '); {loads string into matrix array}ππ straight_display; {display on matrix}π delay(1000);πππ left_right; {scroll from left to right}π delay(1000);ππ right_left; {scroll from right to left}ππ create_dotmat('fading in! '); {set up new msg}π random_fade_in; {randomised fade}π delay(1000);ππ create_dotmat('fade out!! ');π straight_display;π delay(1000);ππ random_fade_out;πππ create_dotmat('can scroll 4 ways!!! ');π left_right;π top_bot; {scroll from top to bottom}π right_left;π bot_top; {scroll from bottom to top}πππ create_dotmat('italics for the font!'); {create new msg}π italics; {generate italics}π random_fade_in;π left_right;π delay(1000);π random_fade_out;ππ create_dotmat('and a special effect '); {create new msg}π left_right;π delay(1000);π create_dotmat('called fall away! ');π left_right;π delay(1000);π fall_away; {demo Special FX}ππ create_dotmat('well, what dya think?');π left_right;π fall_away;ππ create_dotmat('@ iain whyte 1994 ');π random_fade_in;π left_right;π right_left;π random_fade_out;π top_bot;π bot_top;ππππ closegraph; {kill graphics mode}ππend.π 6 08-24-9413:37ALL JENS LARSSON Fast Line Drawing SWAG9408 òy┴ 9 ╓ {π SS> I'm looking for a qwick way to draw a line... All I need areπ SS> horizontal and vertical lines, so would it be easiest to use aπ SS> series of PutPixels?ππUnfortunately you don't specify which mode you're working in, soπI assume it is 320x200 (which tends to be the most popular mode here):π}ππProcedure DHL(x, y, Length : Word; Color : Byte); Assembler;π Asmπ mov ax,0a000hπ mov es,axπ mov ax,yπ shl ax,6π mov di,axπ shl ax,2π add di,axπ add di,xπ mov cx,Lengthπ mov al,Colorπ cldπ rep stosb { I bet I'll get loads of replies which uses stosw instead :) }π End;ππProcedure DVL(x, y, Length : Word; Color : Byte); Assembler;π Asmπ mov ax,0a000hπ mov es,axπ mov ax,yπ shl ax,6π mov di,axπ shl ax,2π add di,axπ add di,xπ mov al,Colorπ mov cx,Lengthπ@DVL1:π mov es:[di],alπ add di,320π dec cxπ jnz @DVL1π End;ππ 7 08-24-9413:37ALL DAAN DE HAAS Fast Polygons SWAG9408 ╠ΘM 105 ╓ {πThis unit draws polygons fast. It draws only polygons which are monotoneπvertical. That means only polygons which you can fill with continues horizontalπlines. Fortunately that are the polygons which are mostly used in 3d graphics.π}ππ{*****************************************************************}π{* UnitName : FASTPOLY.PAS *}π{* Purpose : Draw monotone vertical polygons fast *}π{* Version : 1.5 *}π{* Author : Daan de Haas *}π{* Date : 20/10/1993 *}π{* Last update : 9/06/1994 *}π{* Language : Borland Turbo Pascal 7.0 *}π{* Fidonet : Daan de Haas (2:500/104.6141) *}π{* Internet : Daan.de.Haas@p6141.f104.n500.z2.fidonet.org *}π{*****************************************************************}ππ{* VGA mode $13 and 386 processor *}π{* Literatur : Dr Dobb's XSharp *}ππ{$R-,S-,Q-,I-}ππUNIT FastPoly;ππ{**************************} INTERFACE {**************************}ππTYPEπ PPoint = ^TPoint;π TPoint = RECORDπ x,y:integer;π END;π PPolygon = ^TPolygon;π PPointsList = ^TPointsList;π TPointsList = ARRAY[0..9999] OF TPoint;π TPolygon = RECORDπ length,color:word;π PointPtr:PPointsList;π END;π PHLine = ^THLine;π THLine = RECORDπ XStart,XEnd:word;π END;π PHLineArray = ^THLineArray;π THLineArray = ARRAY[0..9999] OF THLine;π THLineList = RECORDπ length,YStart:integer;π HLinePtr : PHLineArray;π END;ππPROCEDURE HLine(x1,y1,x2:word; color:word);πPROCEDURE InitPoly(VAR p:TPolygon; len,col:word);πPROCEDURE DonePoly(VAR p:TPolygon);πPROCEDURE FillMonotoneVerticalPolygon(XOffset,YOffset:word;π VertexList:TPolygon);ππCONSTπ MaxX=320;π MaxY=200;π VidSegment=$A000;ππ{************************} IMPLEMENTATION {***********************}ππPROCEDURE HLine; ASSEMBLER;πASMπ mov ax,x1 { x1 < x2 }π cmp ax,x2π jl @@skip1π je @@lijnexitπ xchg ax,x2π mov x1,axπ@@skip1:π mov ax,maxX { calculate y1*maxX+x1 }π mul y1π add ax,x1π@@1:π mov di,ax { dx=segment, di=offset }π mov ax,VidSegmentππ@@skip2:π cld { forward direction }π mov cx,x2π sub cx,x1π inc cx { cx = number of pixels in line }π mov dx,diπ add dx,cxπ mov es,ax { load segment register }π mov ax,color { get color into 386 register eax }π mov ah,alπ mov dx,axπ db $66,$c1,$e0,$10 { shl eax,16 (386 code) }π mov ax,dxπ test di,00000011bπ jz @@skip { test for doubleword border, if so jump }π@@waitdd:π mov es:[di],al { put one pixel }π inc di { di:=next pixel address }π test di,00000011b { doubleword border ? }π loopnz @@waitdd { stop if cx=0 or zeroflag 1 }π or cx,cx { cx=0 ? }π jz @@lijnexit { if so, line is ready }π cmp cx,4 { is a stosd possible ? }π jl @@waitdd { no, then pixel after pixel }π@@skip:π mov dx,cxπ shr cx,2π db $f3,$66,$AB { rep stosd (386 code) }π mov cx,dxπ and cx,00000011b { line finished ? }π jnz @@waitddπ@@lijnexit:πEND;ππPROCEDURE ScanEdge(x1,y1,x2,y2,SetXStart,SkipFirst:integer;π VAR EdgePointPtr:PHLineArray); ASSEMBLER;π{ Scan converts an edge from (X1,Y1) to (X2,Y2), not including theπ point at (X2,Y2). If SkipFirst == 1, the point at (X1,Y1) isn'tπ drawn; if SkipFirst == 0, it is. For each scan line, the pixelπ closest to the scanned edge without being to the left of the scannedπ edge is chosen. Uses an all-integer approach for speed & precision.ππ Edges must not go bottom to top; that is, Y1 must be <= Y2.π Updates the pointer pointed to by EdgePointPtr to point to the nextπ free entry in the array of HLine structures. }ππVARπ AdvanceAmt,Height:word;ππASMπ les di,EdgePointPtrπ les di,es:[di] { point to the HLine array }π cmp SetXStart,1 { set the XStart field of each HLineπ { struc? }π jz @@HLinePtrSet { yes, DI points to the first XStart }π add di,2 { no, point to the XEnd field of the }π { first HLine struc }π@@HLinePtrSet:π mov bx,Y2π sub bx,Y1 { edge height }π jle @@ToScanEdgeExit{ guard against 0-length & horz edges }π mov Height,bx { Height = Y2 - Y1 }π sub cx,cx { assume ErrorTerm starts at 0 (true if }π { we're moving right as we draw) }π mov dx,1 { assume AdvanceAmt = 1 (move right) }π mov ax,X2π sub ax,X1 { DeltaX = X2 - X1 }π jz @@IsVertical { it's a vertical edge--special case it }π jns @@SetAdvanceAmt { DeltaX >= 0 }π mov cx,1 { DeltaX < 0 (move left as we draw) }π sub cx,bx { ErrorTerm = -Height + 1 }π neg dx { AdvanceAmt = -1 (move left) }π neg ax { Width = abs(DeltaX) }π@@SetAdvanceAmt:π mov AdvanceAmt,dxπ{ Figure out whether the edge is diagonal, X-major (more horizontal), }π{ or Y-major (more vertical) and handle appropriately. }π cmp ax,bx { if Width==Height, it's a diagonal edge }π jz @@IsDiagonal { it's a diagonal edge--special case }π jb @@YMajor { it's a Y-major (more vertical) edge }π { it's an X-major (more horz) edge }π sub dx,dx { prepare DX:AX (Width) for division }π div bx { Width/Height }π { DX = error term advance per scan line }π mov si,ax { SI = minimum # of pixels to advance X }π { on each scan line }π test AdvanceAmt,8000h { move left or right? }π jz @@XMajorAdvanceAmtSet { right, already set }π neg si { left, negate the distance to advance }π { on each scan line }π@@XMajorAdvanceAmtSet:π mov ax,X1 { starting X coordinate }π cmp SkipFirst,1 { skip the first point? }π jz @@XMajorSkipEntry { yes }π@@XMajorLoop:π mov es:[di],ax { store the current X value }π add di,4 { point to the next HLine struc }π@@XMajorSkipEntry:π add ax,si { set X for the next scan line }π add cx,dx { advance error term }π jle @@XMajorNoAdvance { not time for X coord to advance one }π { extra }π add ax,AdvanceAmt { advance X coord one extra }π sub cx,Height { adjust error term back }π@@XMajorNoAdvance:π dec bx { count off this scan line }π jnz @@XMajorLoopπ jmp @@ScanEdgeDoneπ@@ToScanEdgeExit:π jmp @@ScanEdgeExitπ@@IsVertical:π mov ax,X1 { starting (and only) X coordinate }π sub bx,SkipFirst { loop count = Height - SkipFirst }π jz @@ScanEdgeExit { no scan lines left after skipping 1st }π@@VerticalLoop:π mov es:[di],ax { store the current X value }π add di,4 { point to the next HLine struc }π dec bx { count off this scan line }π jnz @@VerticalLoopπ jmp @@ScanEdgeDoneπ@@IsDiagonal:π mov ax,X1 { starting X coordinate }π cmp SkipFirst,1 { skip the first point? }π jz @@DiagonalSkipEntry { yes }π@@DiagonalLoop:π mov es:[di],ax { store the current X value }π add di,4 { point to the next HLine struc }π@@DiagonalSkipEntry:π add ax,dx { advance the X coordinate }π dec bx { count off this scan line }π jnz @@DiagonalLoopπ jmp @@ScanEdgeDoneππ@@YMajor:π push bp { preserve stack frame pointer }π mov si,X1 { starting X coordinate }π cmp SkipFirst,1 { skip the first point? }π mov bp,bx { put Height in BP for error term calcs }π jz @@YMajorSkipEntry { yes, skip the first point }π@@YMajorLoop:π mov es:[di],si { store the current X value }π add di,4 { point to the next HLine struc }π@@YMajorSkipEntry:π add cx,ax { advance the error term }π jle @@YMajorNoAdvance { not time for X coord to advance }π add si,dx { advance the X coordinate }π sub cx,bp { adjust error term back }π@@YMajorNoAdvance:π dec bx { count off this scan line }π jnz @@YMajorLoopπ pop bp { restore stack frame pointer }π@@ScanEdgeDone:π cmp SetXStart,1 { were we working with XStart field? }π jz @@UpdateHLinePtr { yes, DI points to the next XStart }π sub di,2 { no, point back to the XStart field }π@@UpdateHLinePtr:π mov bx,word ptr EdgePointPtr { point to pointer to HLine array }π mov ss:[bx],di { update caller's HLine array pointer }π@@ScanEdgeExit:πEND;ππPROCEDURE DrawHorizontalLineList(VAR list:THLineList; color:word); ASSEMBLER;πASMπ les si,listπ mov cx,es:[si] { cx = number of lines }π mov ax,es:[si+2] { ax = startY }π les si,es:[si+4] { es:si points to pointlist }π@@loop:π mov bx,es:[si] { get startX }π mov dx,es:[si+2] { get endX }π push cx { save registers }π push axπ push siπ push esππ push bx { draw horizontal line }π push axπ push dxπ mov dx,color { get color }π push dxπ call HLineππ pop es { restore registers }π pop siπ pop axπ pop cxπ inc ax { y:=y+1 }π add si,4 { next points }π loop @@loop { if length=0 then stop }πEND;ππPROCEDURE FillMonotoneVerticalPolygon;πVARπ i,MinIndex,MaxIndex,MinPoint_y,MaxPoint_y,NextIndex,π CurrentIndex,PreviousIndex:integer;π WorkingHLineList:THLineList;π EdgePointPtr:PHLineArray;π VertexPtr:PPointsList;πBEGINπ IF VertexList.Length=0 THEN Exit;π VertexPtr:=VertexList.PointPtr;π MaxPoint_y:=VertexPtr^[0].y;π MinPoint_y:=MaxPoint_y;π MinIndex:=0;π MaxIndex:=0;π FOR i:=1 TO VertexList.Length-1 DOπ WITH VerTexPtr^[i] DOπ IF y<MinPoint_y THENπ BEGINπ MinPoint_y:=y;π MinIndex:=i;π ENDπ ELSEπ IF y>MaxPoint_y THENπ BEGINπ MaxPoint_y:=y;π MaxIndex:=i;π END;π WITH WorkingHLineList DOπ BEGINπ length:=MaxPoint_y-MinPoint_y;π IF length<=0 THEN Exit;π YStart:=YOffset+MinPoint_y;π GetMem(HLinePtr,SizeOf(THLine)*length);π EdgePointPtr:=HLinePtr;π END;π CurrentIndex:=MinIndex;π PreviousIndex:=MinIndex;π REPEATπ CurrentIndex:=(CurrentIndex+VertexList.length-1) MOD VertexList.length;π ScanEdge(VertexPtr^[PreviousIndex].x+XOffset,π VertexPtr^[PreviousIndex].y,π VertexPtr^[CurrentIndex].x+XOffset,π VertexPtr^[CurrentIndex].y,π 1,0,EdgePointPtr);π PreviousIndex:=CurrentIndex;π UNTIL CurrentIndex=MaxIndex;π EdgePointPtr:=WorkingHLineList.HLinePtr;π CurrentIndex:=MinIndex;π PreviousIndex:=MinIndex;π REPEATπ CurrentIndex:=(CurrentIndex+1) MOD VertexList.length;π ScanEdge(VertexPtr^[PreviousIndex].x+XOffset,π VertexPtr^[PreviousIndex].y,π VertexPtr^[CurrentIndex].x+XOffset,π VertexPtr^[CurrentIndex].y,π 0,0,EdgePointPtr);π PreviousIndex:=CurrentIndex;π UNTIL CurrentIndex=MaxIndex;π DrawHorizontalLineList(WorkingHLineList,VertexList.color);π WITH WorkingHLineList DO FreeMem(HLinePtr,SizeOf(THLine)*length);πEND;ππPROCEDURE InitPoly;πBEGINπ WITH p DOπ BEGINπ length:=len;π color:=col;π { No Error checking !}π GetMem(PointPtr,len*SizeOf(TPoint));π END;πEND;ππPROCEDURE DonePoly;πBEGINπ WITH p DOπ BEGINπ IF PointPtr<>NIL THEN FreeMem(PointPtr,length*SizeOf(TPoint));π PointPtr:=NIL;π END;πEND;ππEND.ππ{*****************************************************************}π{* ProgramName : FASTPOL.PAS *}π{* Purpose : Demonstration of unit FastPoly *}π{* Version : 1.0 *}π{* Author : Daan de Haas *}π{* Date : 9 jun 1994 *}π{* Last update : 9 jun 1994 *}π{* Language : Borland Pascal 7.0 *}π{* Fidonet : Daan de Haas (2:500/104.6141) *}π{* Internet : Daan.de.Haas@p6141.f104.n500.z2.fidonet.org *}π{*****************************************************************}ππ{$R-,I-,Q-,S-}ππUSESπ Crt, FastPoly;ππPROCEDURE SetVideo(m:word); ASSEMBLER;πASMπ mov ax,mπ int $10πEND;ππPROCEDURE Polydemo;πVARπ p1,p2:TPolygon;πBEGINπ InitPoly(p1,6,YELLOW);π p1.PointPtr^[0].X:=10;π p1.PointPtr^[0].Y:=0;π p1.PointPtr^[1].X:=20;π p1.PointPtr^[1].Y:=0;π p1.PointPtr^[2].X:=30;π p1.PointPtr^[2].Y:=10;π p1.PointPtr^[3].X:=20;π p1.PointPtr^[3].Y:=20;π p1.PointPtr^[4].X:=10;π p1.PointPtr^[4].Y:=20;π p1.PointPtr^[5].X:=0;π p1.PointPtr^[5].Y:=10;π InitPoly(p2,6,BLUE);π p2.PointPtr^[0].X:=10;π p2.PointPtr^[0].Y:=0;π p2.PointPtr^[1].X:=20;π p2.PointPtr^[1].Y:=0;π p2.PointPtr^[2].X:=30;π p2.PointPtr^[2].Y:=10;π p2.PointPtr^[3].X:=20;π p2.PointPtr^[3].Y:=20;π p2.PointPtr^[4].X:=10;π p2.PointPtr^[4].Y:=20;π p2.PointPtr^[5].X:=0;π p2.PointPtr^[5].Y:=10;π REPEATπ FillMonotoneVerticalPolygon(Random(MaxX-35),Random(MaxY-25),p1);π FillMonotoneVerticalPolygon(Random(MaxX-35),Random(MaxY-25),p2);π UNTIL KeyPressed;π ReadKey;π DonePoly(p1);π DonePoly(p2);πEND;ππBEGINπ ClrScr;π Randomize;π SetVideo($13);π PolyDemo;π SetVideo(3);πEND.π 8 08-24-9413:38ALL ALEX CHALFIN Fire Graphic SWAG9408 4[╒¿ 32 ╓ {πHere is a little something for all you pyromaniacs, and demo coders out there.ππI got my hands on Jare's fire code and thought it was pretty cool, so I madeπmy own fire program. Although it didn't turn out like I thought it would (likeπJare's) what I have is (at least I think so) something that looks moreπrealistic.ππThis program was completely written by myself and was inspired by Jare's fireπcode (available on Internet FTP at ftp.eng.ufl.edu pub/msdos/demos/programmingπ/source). A 386 computer is required (Double Word copies are used), but a 486πis highly recommended, as 28800 pixels are calculated each frame (I useπstandard mode 13h). The entire source is Pascal/Inline asm and was writtenπusing Turbo Pascal v6.0. I hope you like it.πππ{ **** Program starts here ******** }ππProgram Phire;π{$G+} { Enable 286 instructions }π{ coded by Phred 7/23/94 aka Alex Chalfin }π{ Internet: achalfin@uceng.uc.edu }π{ A fast computer is HIGHLY recommended. }π{ Inspired by Jare's fire code }ππVarπ Screen : Array[0..63999] of Byte ABSOLUTE $A000:$0000; { the VGA screen }π VScreen : Array[0..63999] of Byte; { an offscreen buffer }π Lookup : Array[0..199] of Word; { an Offset lookup table }ππProcedure SetPalette; Near;π{ Sets the Palette }ππVarπ p : Array[0..767] of Byte;π x : integer;ππBeginπ for x := 0 to 255 do { Generate fade from orange to black }π Beginπ p[x*3] := (x * 63) Shr 8;π P[x*3+1] := (x * 22) Shr 8;π P[x*3+2] := 0;π End;π Port[$3C8] := 0;π For x := 0 to 255 do { Set the palette }π Beginπ Port[$3C9] := P[x*3];π Port[$3C9] := P[x*3+1];π Port[$3C9] := P[x*3+2];π End;πEnd;ππProcedure Burnin_Down_The_House;ππVarπ c : Integer;ππBeginπ Randomize;π Repeatπ For c := 0 to 319 do { Setup bottom line "hot spots" }π If Random(4) = 1π Then VScreen[LookUp[199] + c] := Random(3) * 255;π Asmπ MOV CX,28800 { Number of pixels to calculate }π PUSH CX { Store count on stack }π MOV AX,Offset VScreenπ PUSH AX { Store value on stack }π MOV SI,AXπ MOV BX,199π SHL BX,1π MOV AX,Word Ptr [LookUp + BX]π ADD SI,AXπ DEC SI { DS:SI := VScreen[LookUp[198]+319] }π @Looper:π XOR AX,AXπ XOR BX,BXπ MOV AL,DS:[SI+319]π ADD BX,AXπ MOV AL,DS:[SI+320]π ADD BX,AXπ MOV AL,DS:[SI+321]π ADD BX,AXπ MOV AL,DS:[SI]π ADD BX,AX { Average the three pixels below and the one that its on}π SHR BX,2 { Divide by 4 }π JZ @Skipπ DEC BX { Subtract 1 if value > 0 }π @Skip:π MOV DS:[SI],BL { Store pixel to screen }π DEC SI { Move to next pixel }π DEC CXπ JNZ @Looperπ { Copy the screen Buffer using Double Word copies }π MOV BX,110π SHL BX,1π MOV AX,Word Ptr [LookUp + BX]π MOV DX,AXπ POP SI { Restore starting offset of VScreen }π MOV AX,$A000π MOV ES,AX { DS:SI = starting location in buffer }π XOR DI,DI { ES:DI = Starting location in screen }π ADD SI,DXπ ADD DI,DXπ POP CX { Retrive Count off the stack }π SHR CX,2 { divide by 4 to get # of double words. }π db 66h { Since TP won't allow 386 instructions, fake it. }π REP MOVSW { This translates into REP MOVSD (move double words) }π End;π Until Port[$60] = 1; { Until ESC is pressed }πEnd;ππBeginπ Asm { Initialize mode 13h VGA mode }π MOV AX,13hπ INT 10hπ End;π For LookUp[0] := 1 to 199 do { Calculate lookup table }π LookUp[LookUp[0]] := LookUp[0] * 320;π LookUp[0] := 0;π SetPalette;π FillChar(VScreen, 64000, 0);π Burnin_Down_The_House;π Asmπ MOV AX,3π INT 10hπ End;πEnd.ππ 9 08-24-9413:40ALL FRED JOHNSON FONTS WITH TURBOPASCAL V7SWAG9408 ù┤ƒì 19 ╓ π{compile the *.bgi and *.chr files into a .exe file? If so how?ππ1. Collect all the fonts you canπ If you don't have them all, fake it (use old one in place of real one)π2. Compile them separately into OBJ filesπ example: binobj bold.chr bold.obj boldππ3. DO the BGI driver for your video card.π example: binobj egavga.bgi egavga.obj egavgaππ4. use the TPUs in your main progπ5. Load the video driver like an external procedure;πππ{-------------------------------example 1 (converts chr->obj->tpu)}ππunit boldfont; {use the name + font for all of the fonts}ππinterfaceπprocedure bold;πimplementationπprocedure bold; external;π{$L bold.obj}πend.π{------------------------------------------------------------------------}ππ{--------------------------------example 2}πuses graph,π boldfont, eurofont, gothfont, lcomfont, littfont,π sansfont, simpfont, scrifont, tripfont, tscrfont;ππprocedure egavga; external;π{$L egavga.obj}ππconstπ xFonts : array[0..10] of recordπ sFontName : string;π xpFontAddr : pointer;π end =π ( {Fonts must remain in this order because of settextstyle()}π (sFontName :'Default'; xpFontAddr : nil), {style 00}π (sFontName :'Triplex'; xpFontAddr : @TRIP),{style 01}π (sFontName :'Small'; xpFontAddr : @LITT),{style 02}π (sFontName :'Sans'; xpFontAddr : @SANS),{style 03}π (sFontName :'Gothic'; xpFontAddr : @GOTH),{style 04}π (sFontName :'Script'; xpFontAddr : @SCRI),{style 05}π (sFontName :'Simplex'; xpFontAddr : @SIMP),{style 06}π (sFontName :'Tscr'; xpFontAddr : @TSCR),{style 07}π (sFontName :'Lcom'; xpFontAddr : @LCOM),{style 08}π (sFontName :'Euro'; xpFontAddr : @EURO),{style 09}π (sFontName :'Bold'; xpFontAddr : @BOLD) {style 10}π );ππvarπ gd, gm, i : integer;ππbeginπ if RegisterBGIDriver(@EGAVGA) < 0 then halt;π for i := 1 to 10 doπ if RegisterBGIFont(xFonts[i].xpFontAddr) < 0 thenπ write('Can''t register', xFonts[i].sFontName,' font');ππ gd := VGA;π gm := VGAHi;π initgraph(gd, gm, '');ππ for i := 0 to 10 doπ beginπ settextstyle(i,0,10);π outtextxy(10,20,xFonts[i].sFontName);π readln;π cleardevice;π end;π closegraph;πend.π 10 08-24-9413:40ALL DAVID DANIEL ANDERSON Gif info display SWAG9408 ▓ÆA╨ 36 ╓ {πBS> Can anone out there tell me where you get the resoloution out of a Gif fileπBS> from? What I am saying is, I would like to make a program to look at a GifπBS> and grab the resoloution out of it for my dir list files. Any help would beπBS> appreciated.ππI've written a freeware program to do just this. Program name is GRR,πand Pascal source accompanies it. Here is the source from the latestπ(and only) version. I apologize for the lack of comments, but it isπrather straightforward, I think. }ππprogram getGIFheader;πusesπ dos;πconstπ progdata = 'GRR- Free DOS utility: GIF file info displayer.';π progdat2 =π 'V1.00: August 19, 1993. (c) 1993 by David Daniel Anderson - Reign Ware.';π usage =π 'Usage: GRR directory and/or file_spec[.GIF] Example: GRR cindyc*';πvarπ header : string[6];π gpixn : byte;π gpixels, gback, rwidthLSB, rheightLSB, rwidth, rheight : char;π gifname : string[12];π giffile : text;π dirinfo : searchrec;π gpath : pathstr;π gdir : dirstr;π gname : namestr;π gext : extstr;ππprocedure showhelp;πbegin {-- showhelp --}π writeln(progdata);π writeln(progdat2);π writeln(usage);π halt;πend {-- showhelp --};ππfunction taffy(astring : string; newlen : byte) : string;πbegin {-- taffy --}π while (length(astring) < newlen) doπ astring := astring + ' ';π taffy := astring;πend {-- taffy --};ππfunction LeadingZero(w : Word) : string;πvarπ s : string;πbegin {-- LeadingZero --}π Str(w : 0, s);π if (length(s) = 1) thenπ s := '0' + s;π LeadingZero := s;πend {-- LeadingZero --};ππprocedure writeftime(fdatetime : longint);πvarπ Year2 : string;π DateTimeInf : DateTime;πbegin {-- writeftime --}π UnpackTime(fdatetime, DateTimeInf);π with DateTimeInf doπ beginπ Year2 := LeadingZero(Year);π Delete(Year2, 1, 2);π Write(LeadingZero(Month), '-', LeadingZero(Day), '-', Year2, ' ',π LeadingZero(Hour), ':', LeadingZero(Min), ':', LeadingZero(Sec));π end;πend {-- writeftime --};πππprocedure displaygifscreenstats(screendes : byte);πvarπ GCM : Boolean;πbegin {-- displaygifscreenstats --}π GCM := screendes > 128;π if (screendes > 128) thenπ screendes := screendes - 128;π if (screendes > 64) thenπ screendes := screendes - 64;π if (screendes > 32) thenπ screendes := screendes - 32;π if (screendes > 16) thenπ screendes := screendes - 16;π if (screendes > 8) thenπ screendes := screendes - 8;π case (screendes) ofπ 0: Write(' 2');π 1: Write(' 4');π 2: Write(' 8');π 3: Write(' 16');π 4: Write(' 32');π 5: Write(' 64');π 6: Write('128');π 7: Write('256');π end {-- CASE --};π if (GCM) thenπ Write(' ] GCM/')π elseπ Write(' ] ---/');πend {-- displaygifscreenstats --};ππprocedure checkforgiflite(var thefile : text);πvarπ ic : Word;π dummy, glite : char;π gliteword : string[7];πbegin {-- checkforgiflite --}π for ic := 13 to 784 doπ read(thefile, dummy);π gliteword := ' ';π for ic := 1 to 7 doπ beginπ read(thefile, glite);π gliteword[ic] := glite;π end;π if (pos('GIFLITE', gliteword) = 1) thenπ Write('GL')π elseπ Write('--');πend {-- checkforgiflite --};ππbegin {-- getGIFheader --}π gpath := '';π gpath := paramstr(1);π if (gpath = '') thenπ gpath := '*.gif';π if (pos('.', gpath) <> 0) thenπ beginπ gpath := copy(gpath, 1, pos('.', gpath));π gpath := gpath + 'gif'π endπ elseπ gpath := gpath + '*.gif';π fsplit(fexpand(gpath), gdir, gname, gext);π findfirst(gpath, archive, dirinfo);π if (doserror <> 0) thenπ showhelp;π while (doserror = 0) doπ beginπ gifname := dirinfo.name;π assign(giffile, gdir + gifname);π reset(giffile);π read(giffile, header);π if (pos('GIF', header) <> 1) thenπ header := '?_GIF?';π read(giffile, rwidthLSB, rwidth, rheightLSB, rheight, gpixels, gback);π gifname := taffy(gifname, 12);π Write(gifname, ' ', dirinfo.size:7, ' ');π writeftime(dirinfo.time);π Write(' ', header, ' [');π Write((ord(rwidthLSB) + (256 * ord(rwidth))):4, ' ',π (ord(rheightLSB) + (256 * ord(rheight))):4, ' ');π gpixn := ord(gpixels);π displaygifscreenstats(gpixn);π { write ( ', ', ord ( gback )); }π { This is the background color, commented out since it is not used }π checkforgiflite(giffile);π writeln;π close(giffile);π findnext(dirinfo);π end;πend {-- getGIFheader --}.π 11 08-24-9413:41ALL ERIC MILLER Graphic Compression SWAG9408 ╫'∙U 10 ╓ {π TW> I'll need an algorithm to make a graphic smaller.ππ TW> I will read a 640x480x256 and want to make it a smaller size.π TW> For example 80x60x256 or 160x120x256 or something else.π TW> Maybe someone could send me an algorithm or a sample.ππ If you simply want a smaller version of the original image, thenπ it's easy.ππ ie, for 640x480 to 160x120 ( 1/4 original size)π}ππ FOR Y := 0 TO 119 { 160x120 Y axis }π BEGINπ NewY := (Y * 4); { corresponding point on 640x480 Y axis }π FOR X := 0 TO 159 DO { 160x120 X axis }π BEGINπ NewX := (X * 4); { corresponding point on 640x480 X axis }π Image160x120[Y, X] := Image640x480[NewY, NewX];π END;π END;ππ See, simply multiply each point in 160x120 by 4 to get correspondingπ point in 640x480. This of course skips all pixels in between...π Also, the in the example above, note that you cannot haveπ an array of [0..479, 0..639] of Byte! I just put that in thereπ to show how it is done.ππ Eric Millerπ mysticm@ephsa.sat.tx.usπ 12 08-24-9413:42ALL PAUL BROMAN Pallete Handling SWAG9408 g├v6 53 ╓ { GrafCont initializes the graphics mode and handles pallete fades. }ππunit GrafCont;ππinterfaceππusesπ Crt, Dos, Graph;ππtypeπ Palette256 = array[0..255, 0..2] of Byte;π Palette16 = array[0..15, 0..2] of Byte;ππvarπ Mode : byte;ππprocedure Init256VGA;πprocedure Init16VGA;πprocedure SetVGAPalette256(PalBuf: Palette256);πprocedure GetVGAPalette256(var PalBuf: Palette256);πprocedure SetVGAPalette16(PalBuf: Palette16);πprocedure GetVGAPalette16(var PalBuf: Palette16);πprocedure GetRGBPalette(PalNum: integer; var R, G, B: byte);πprocedure FadeOutScreen256;πprocedure FadeOutScreen16;πprocedure FadeInScreen256(PalToMake: Palette256);πprocedure FadeInScreen16(PalToMake: Palette16);ππimplementationππprocedure Init256VGA;π {This procedure relies on BGI drivers obtained for Pascal.π You may need to create a new procedure based on your ownπ method for turning on the graphics mode.}ππ varπ graphmode : integer;π graphdriver : integer;ππ beginπ graphdriver := VGA256Graph; {Defined as an OBJ}π graphmode := 0;π initgraph(graphdriver, graphmode, '');π end;ππprocedure Init16VGA;π varπ graphdriver : integer;π graphmode : integer;ππ beginπ graphdriver := 9;π graphmode := 2;π initgraph(graphdriver, graphmode, '');π end;ππprocedure SetVGAPalette256;πvarπ ColorOn : byte;ππbeginπ Port[$3C8] := 0;π for ColorOn := 0 to 255 doπ beginπ Port[$3C9] := PalBuf[ColorOn, 0];π Port[$3C9] := PalBuf[ColorOn, 1];π Port[$3C9] := PalBuf[ColorOn, 2];π end;πend;ππprocedure GetVGAPalette256;πvarπ ColorOn : byte;ππbeginπ Port[$3C8] := 1;π for ColorOn := 0 to 255 doπ beginπ PalBuf[ColorOn, 0] := Port[$3C9];π PalBuf[ColorOn, 1] := Port[$3C9];π PalBuf[ColorOn, 2] := Port[$3C9];π end;π PalBuf[0, 0] := 0;π PalBuf[0, 1] := 0;π PalBuf[0, 2] := 0;πend;ππprocedure SetVGAPalette16;πvarπ ColorOn : byte;ππbeginπ Port[$3C8] := 0;π for ColorOn := 0 to 15 doπ beginπ Port[$3C9] := PalBuf[ColorOn, 0];π Port[$3C9] := PalBuf[ColorOn, 1];π Port[$3C9] := PalBuf[ColorOn, 2];π end;πend;ππprocedure GetVGAPalette16;πvarπ ColorOn : byte;ππbeginπ Port[$3C8] := 1;π for ColorOn := 0 to 15 doπ beginπ PalBuf[ColorOn, 0] := Port[$3C9];π PalBuf[ColorOn, 1] := Port[$3C9];π PalBuf[ColorOn, 2] := Port[$3C9];π end;π PalBuf[0, 0] := 0;π PalBuf[0, 1] := 0;π PalBuf[0, 2] := 0;πend;πππprocedure GetRGBPalette;ππbeginπ Port[$3C8] := PalNum;π R := Port[$3C9];π G := Port[$3C9];π B := Port[$3C9];πend;ππprocedure FadeOutScreen256;π varπ Count : word;π ColorOn : byte;π PalToMake : Palette256;π PaletteStuff : Palette256;ππ beginπ GetVGAPalette256(PaletteStuff);π PalToMake := PaletteStuff;π for Count := 63 downto 0 doπ beginπ Port[$3C8] := 0;π PaletteStuff := PalToMake;π Delay(1);π for ColorOn := 0 to 255 doπ beginπ PaletteStuff[ColorOn, 0] := (PaletteStuff[ColorOn, 0] * Count) div 63;π PaletteStuff[ColorOn, 1] := (PaletteStuff[ColorOn, 1] * Count) div 63;π PaletteStuff[ColorOn, 2] := (PaletteStuff[ColorOn, 2] * Count) div 63;π Port[$3C9] := PaletteStuff[ColorOn, 0];π Port[$3C9] := PaletteStuff[ColorOn, 1];π Port[$3C9] := PaletteStuff[ColorOn, 2];π end;π end;π end;ππprocedure FadeOutText;π varπ Count : word;π ColorOn : byte;π PalToMake : Palette256;π PaletteStuff : Palette256;ππ beginπ GetVGAPalette256(PaletteStuff);π PalToMake := PaletteStuff;π for Count := 63 downto 0 doπ beginπ Port[$3C8] := 0;π PaletteStuff := PalToMake;π Delay(20);π for ColorOn := 0 to 255 doπ beginπ PaletteStuff[ColorOn, 0] := (PaletteStuff[ColorOn, 0] * Count) div 63;π PaletteStuff[ColorOn, 1] := (PaletteStuff[ColorOn, 1] * Count) div 63;π PaletteStuff[ColorOn, 2] := (PaletteStuff[ColorOn, 2] * Count) div 63;π Port[$3C9] := PaletteStuff[ColorOn, 0];π Port[$3C9] := PaletteStuff[ColorOn, 1];π Port[$3C9] := PaletteStuff[ColorOn, 2];π end;π end;π end;ππprocedure FadeInScreen256;π varπ Count : byte;π ColorOn : byte;π PaletteStuff : Palette256;π FastPal : Palette256;ππ beginπ GetVGAPalette256(PaletteStuff);π for Count := 0 to 63 doπ beginπ Port[$3C8] := 0;π PaletteStuff := PalToMake;π Delay(1);π for ColorOn := 0 to 255 doπ beginπ PaletteStuff[ColorOn, 0] := (PaletteStuff[ColorOn, 0] * Count) div 63;π PaletteStuff[ColorOn, 1] := (PaletteStuff[ColorOn, 1] * Count) div 63;π PaletteStuff[ColorOn, 2] := (PaletteStuff[ColorOn, 2] * Count) div 63;π Port[$3C9] := PaletteStuff[ColorOn, 0];π Port[$3C9] := PaletteStuff[ColorOn, 1];π Port[$3C9] := PaletteStuff[ColorOn, 2];π end;π end;π end;ππprocedure FadeOutScreen16;π varπ Count : word;π ColorOn : byte;π PalToMake : Palette16;π PaletteStuff : Palette16;ππ beginπ GetVGAPalette16(PaletteStuff);π PalToMake := PaletteStuff;π for Count := 63 downto 0 doπ beginπ Port[$3C8] := 0;π PaletteStuff := PalToMake;π Delay(5);π for ColorOn := 0 to 15 doπ beginπ PaletteStuff[ColorOn, 0] := (PaletteStuff[ColorOn, 0] * Count) div 63;π PaletteStuff[ColorOn, 1] := (PaletteStuff[ColorOn, 1] * Count) div 63;π PaletteStuff[ColorOn, 2] := (PaletteStuff[ColorOn, 2] * Count) div 63;π Port[$3C9] := PaletteStuff[ColorOn, 0];π Port[$3C9] := PaletteStuff[ColorOn, 1];π Port[$3C9] := PaletteStuff[ColorOn, 2];π end;π end;π end;ππprocedure FadeInScreen16;π varπ Count : byte;π ColorOn : byte;π PaletteStuff : Palette16;π FastPal : Palette16;ππ beginπ GetVGAPalette16(PaletteStuff);π for Count := 0 to 63 doπ beginπ Port[$3C8] := 0;π PaletteStuff := PalToMake;π Delay(5);π for ColorOn := 0 to 15 doπ beginπ PaletteStuff[ColorOn, 0] := (PaletteStuff[ColorOn, 0] * Count) div 63;π PaletteStuff[ColorOn, 1] := (PaletteStuff[ColorOn, 1] * Count) div 63;π PaletteStuff[ColorOn, 2] := (PaletteStuff[ColorOn, 2] * Count) div 63;π Port[$3C9] := PaletteStuff[ColorOn, 0];π Port[$3C9] := PaletteStuff[ColorOn, 1];π Port[$3C9] := PaletteStuff[ColorOn, 2];π end;π end;π end;ππend.ππ 13 08-24-9413:46ALL GARTH KRUMINS MODE-X Routines SWAG9408 ╬å2 17 ╓ {π JW> What is mode-x or ($13) or whatever in graphics. I like to writeπ Mode-x is just your 320x200x256 VGA graphics mode.ππIt's pretty similar to using pascal's graph unit, except you don't! You haveπto get all the procedures and functions set-up yourself.π}ππPROCEDURE InitVGA; ASSEMBLER; {Puts you in 320x200x256 VGA}πasm π mov ax, 13h π int 10h πend; π πPROCEDURE InitTEXT; ASSEMBLER; {Puts you back in 80x25 text mode} πasm π mov ax, 03h π int 10h πend; ππPROCEDURE SetColor (ColorNo, Red, Green, Blue : byte); πbegin {Changes the pallete data for a particular colour} π PORT[$3C8] := ColorNo; π PORT[$3C9] := Red; π PORT[$3C9] := Green; π PORT[$3C9] := Blue; πend; π πPROCEDURE MovCursor (X,Y : byte); {Moves the cursor to (X,Y)} πbegin π asm π MOV ah, 02h π XOR bx, bx π MOV dh, Y π MOV dl, X π INT 10h π end; πend; π πFUNCTION ReadCursorX: byte; assembler; {Get X position of cursor}πasm π MOV ah, 03h π XOR bx, bx π INT 10h π MOV al, dl πend; π πFUNCTION ReadCursorY: byte; assembler; {Get Y position of cursor} πasm π MOV ah, 03h π XOR bx, bx π INT 10h π MOV al, dh πend; π πPROCEDURE PutText (TextData : string; Color : byte); {Write a string} πvar {It's not the fastest way to do it, but it does the job} π z, ASCdata, CursorX, CursorY : byte; πbegin π CursorX := ReadCursorX;π CursorY := ReadCursorY; π for z := 1 to Length(TextData) do π begin π ASCdata := Ord(TextData[z]); π asm π MOV ah, 0Ah π MOV al, ASCdata π XOR bx, bx π MOV bl, Color π MOV cx, 1 π INT 10h π end; π inc(CursorX); π if CursorX=40 then begin CursorX:=0; inc(CursorY); end; π MovCursor(CursorX,CursorY); π end; πend; π πPROCEDURE PlotPixel(X, Y: Word; Color: Byte); ASSEMBLER; {Plots a pixel} πasmπ push es π push di π mov ax, Y π mov bx, ax π shl ax, 8 π shl bx, 6 π add ax, bx π add ax, X π mov di, ax π mov ax, $A000 π mov es, ax π mov al, Color π mov es:[di], al π pop diπ pop esπend;π 14 08-24-9413:50ALL JAMES COOK Pcx Viewer! SWAG9408 φE:] 30 ╓ πUses Crt;π{ Sample program to display a 320x200x256 PCX inπ mode 13h. PCX source copied from MCGA07, a MCGAπ graphics unit written by James Cook in his MCGAπ programming tutorial on Quantum Leap BBS }ππTYPEπ TPalette = array[0..767] of Byte;π PalettePtr = ^TPalette;π{ PCX stuff }π PCXHeaderPtr= ^PCXHeader;π PCXHeader = recordπ Signature : Char;π Version : Char;π Encoding : Char;π BitsPerPixel : Char;π XMin,YMin,π XMax,YMax : Integer;π HRes,VRes : Integer;π Palette : Array [0..47] of byte;π Reserved : Char;π Planes : Char;π BytesPerLine : Integer;π PaletteType : Integer;π Filler : Array [0..57] of byte;π end;ππProcedure ExtractLineASM (BytesWide:Integer;Var Source,Dest:Pointer);πvarπ DestSeg,π DestOfs,π SourceSeg,π SourceOfs : Word;πbeginπ SourceSeg := Seg (Source^);π SourceOfs := Ofs (Source^);π DestSeg := Seg (Dest^);π DestOfs := Ofs (Dest^);ππ asmπ push dsπ push siππ cldππ mov ax,DestSegπ mov es,axπ mov di,DestOfs { es:di -> destination pointer }π mov ax,SourceSegπ mov ds,axπ mov si,SourceOfs { ds:si -> source buffer }ππ mov bx,diπ add bx,BytesWide { bx holds position to stop for this row }π xor cx,cxππ @@GetNextByte:π cmp bx,di { are we done with the line }π jbe @@ExitHereππ lodsb { al contains next byte }ππ mov ah,alπ and ah,0C0hπ cmp ah,0C0hππ jne @@SingleByteπ { must be a run of bytes }π mov cl,alπ and cl,3Fhπ lodsbπ rep stosbπ jmp @@GetNextByteππ @@SingleByte:π stosbπ jmp @@GetNextByteππ @@ExitHere:π mov SourceSeg,dsπ mov SourceOfs,siπ mov DestSeg,esπ mov DestOfs,diππ pop siπ pop dsπ end;ππ Source := Ptr (SourceSeg,SourceOfs);π Dest := Ptr (DestSeg,DestOfs);πend;ππProcedure DisplayPCX (X,Y:Integer;Buf:Pointer);πvarπ I,NumRows,π BytesWide : Integer;π Header : PCXHeaderPtr;π DestPtr : Pointer;π Offset : Word;ππbeginπ Header := Ptr (Seg(Buf^),Ofs(Buf^));π Buf := Ptr (Seg(Buf^),Ofs(Buf^)+128);π Offset := Y * 320 + X;π NumRows := Header^.YMax - Header^.YMin + 1;π BytesWide := Header^.XMax - Header^.XMin + 1;π If Odd (BytesWide) then Inc (BytesWide);ππ For I := 1 to NumRows do beginπ DestPtr := Ptr ($A000,Offset);π ExtractLineASM (BytesWide,Buf,DestPtr);π Inc (Offset,320);π end;πend;π{ end PCX stuff }ππProcedure Graph13h; assembler;πasmπ mov al,$13π mov ah,0π int 10hπend;ππVARπ F: File; { PCX file }π Hdr: PCXHeaderPtr; { PCX header structure & file }π Pal: PalettePtr; { PCX palette }π Shade, Size: Word; { RGB shade, file size }ππBEGINπ Graph13h; { set mode 13h }π Assign(F, 'filename.pcx'); { open PCX file }π Reset(F,1);π Size := FileSize(F);π GetMem(Hdr, Size); { load PCX into memory }π Blockread(F, Hdr^, Size);π Close(F);π Pal := Ptr( Seg(Hdr^), Ofs(Hdr^) + Size - 768); { get palette location }π Port[968] := 0; { set palette }π FOR Shade := 0 TO 767 DOπ Port[969] := Pal^[Shade] SHR 2;π DisplayPCX(0, 0, Hdr); { decode PCX to screen }π WHILE Readkey <> #13 DO; { wait for return key }π TextMode(CO80);πEND.π 15 08-24-9413:50ALL OLAF BARTELT Vga 256 Color PCX SWAG9408 ┘* ô 22 ╓ {π CF> I am working with VGA 320x200x256. Can anyone please helpπ CF> me with a good line routine and the PCX format? I haveπ CF> tryed both and things go bad.. If you have code layingπ CF> around it would help me a lot... Thanksππ}ππPROCEDURE load_pcx(dx, dy : WORD; name : STRING);πVAR q : FILE; { Quellendatei-Handle }π b : ARRAY[0..2047] OF BYTE; { Puffer }π anz, pos, c, w, h, e, pack : WORD; { diverse benötigte Variablen }π x, y : WORD; { für die PCX-Laderoutine }ππLABEL ende_background; { Sprungmarken definieren }ππBEGINπ x := dx; y := dy; { Nullpunkt festsetzen }ππ ASSIGN(q, name); {$I-} RESET(q, 1); {$I+} { Quellendatei öffnen }π IF IORESULT <> 0 THEN { Fehler beim Öffnen? }π GOTO ende_background; { Ja: zum Ende springen }ππ BLOCKREAD(q, b, 128, anz); { Header einlesen }ππ IF (b[0] <> 10) OR (b[3] <> 8) THEN { wirklich ein PCX-File? }π BEGINπ CLOSE(q); { Nein: Datei schließen und }π GOTO ende_background; { zum Ende springen }π END;ππ w := SUCC((b[9] - b[5]) SHL 8 + b[8] - b[4]); { Breite auslesen }π h := SUCC((b[11] - b[7]) SHL 8 + b[10] - b[6]); { Höhe auslesen }ππ pack := 0; c := 0; e := y + h;π REPEATπ BLOCKREAD(q, b, 2048, anz);ππ pos := 0;π WHILE (pos < anz) AND (y < e) DOπ BEGINπ IF pack <> 0 THENπ BEGINπ FOR c := c TO c + pack DOπ MEM[SEGA000:y*320+(x+c)] := b[pos];π pack := 0;π ENDπ ELSEπ IF (b[pos] AND $C0) = $C0 THENπ pack := b[pos] AND $3Fπ ELSEπ BEGINπ MEM[SEGA000:y*320+(x+c)] := b[pos];π INC(c);π END;ππ INC(pos);π IF c = w THEN { letzte Spalte erreicht? }π BEGINπ c := 0; { Ja: Spalte auf 0 setzen und }π INC(y); { in die nächste Zeile }π END;π END;π UNTIL (anz = 0) OR (y = e);ππ SEEK(q, FILESIZE(q) - 3 SHL 8 - 1);π BLOCKREAD(q, b, 3 SHL 8 + 1);ππ IF b[0] = 12 THENπ FOR x := 1 TO 3 SHL 8 + 1 DOπ b[x] := b[x] SHR 2;ππ PORT[$3C8] := 0;ππ FOR x := 0 TO 255 DOπ BEGINπ PORT[$3C9] := b[x*3+1];π PORT[$3C9] := b[x*3+2];π PORT[$3C9] := b[x*3+3];π END;ππ CLOSE(q);ππende_background:πEND;ππBEGINπ Load_Pcx(1,1,'c:\lpexface.pcx');πEND. 16 08-24-9413:50ALL ANDREW EIGUS Pcx Bitmap Rotating SWAG9408 tôp 127 ╓ { ROTATE.PAS }ππ{π Rotating textured surface.π Coded by Mike Shirobokov(MSH) aka Mad Max / Queue members.π You can do anything with this code until this commentsπ remain unchanged.ππ Bugs corrected by Alex Grischenkoπ}ππ{$G+,A-,V-,X+}π{$M 16384,0,16384}ππuses Crt, Objects, Memory, VgaGraph; { unit code at the end of program }ππconstπ{ Try to play with this constants }π RotateSteps = {64*5}65*10;π AngleStep = {3}1;π MoveStep = {10}1;π ScaleStep : Real = 0.02;ππtypeπ TBPoint = record X,Y: { Byte} Integer; end;π TPointArray = array[ 1..500 ] of TBPoint;ππ TRotateApp = object(TGraphApplication)π StartTime,π FramesNumber:LongInt;π {Texture: TImage;}π X,Y : Integer;π WSX,WSY: Integer;π WSXR,π WSYR : Real;π Angle : Integer;π Size : TPoint;π CurPage: Integer;π Texture: TImage;π constructor Init;π procedure Run; virtual;π destructor Done; virtual;π procedure Draw; virtual;π procedure FlipPage; virtual;π procedure Rotate( AngleStep: Integer );π procedure Move( DeltaX, DeltaY: Integer );π procedure Scale( Factor: Real );π procedure Update;π end;πvarπ Pal: TRGBPalette;π Time: LongInt absolute $0:$46C;ππprocedure TRotateApp.FlipPage;πbeginπ CurPage := 1-CurPage;π ShowPage(1-CurPage);πend;ππconstructor TRotateApp.Init;πvarπ I, J: Integer;πbeginπ if not inherited Init(True) or not Texture.Load( ParamStr(1) ) then Fail;π SetPalette( Texture.Palette );π X := 0;π Y := 0;π WSX := 240;π WSY := 360;π WSXR := WSX;π WSYR := WSY;π Angle := 0;π Size.X := HRes div 2;π Size.Y := VRes div 2;π FramesNumber := 0;π StartTime := Time; { asm mov ax,13h; int 10h; end;}π system.move (Texture.Data^,Screen,64000);π SetPalette( Texture.Palette );π{ readkey;}πend;ππprocedure TRotateApp.Rotate( AngleStep: Integer );πbeginπ Inc( Angle, AngleStep );π Angle := Angle mod RotateSteps;πend;ππprocedure TRotateApp.Move( DeltaX, DeltaY: Integer );πbeginπ Inc( X, DeltaX );π Inc( Y, DeltaY );πend;ππprocedure TRotateApp.Scale( Factor: Real );πbeginπ WSXR := WSXR*Factor;π WSX := Round(WSXR);π WSYR := WSYR*Factor;π WSY := Round(WSYR);πend;ππprocedure TRotateApp.Update;πbeginπ Move( MoveStep, MoveStep );π Rotate(AngleStep);π Scale(1+ScaleStep);π if (WSY >= 2000) or (WSY<=100) then ScaleStep := -ScaleStep;πend;ππprocedure TRotateApp.Draw;ππvarπ I : Integer;π Border,π LineBuf: TPointArray;π BorderLen: Integer;π X1RN,X1LN,π Y1RN,Y1LN,π X2RN,X2LN,π Y2RN,Y2LN,π X1R,X1L,π Y1R,Y1L,π X2R,X2L,π Y2R,Y2L,π XL,YL: Integer;ππ{ This function can be heavly optimized but I'm too lazy to do absoletelyπ meaningless things :-) }πfunction BuildLine( var Buffer: TPointArray; X1,Y1, X2,Y2: Integer;π Len: Integer ): Integer;πvarπ I: Word;π XStep,π YStep: LongInt;πbeginπ XStep := (LongInt(X2-X1) shl 16) div Len;π YStep := (LongInt(Y2-Y1) shl 16) div Len;π for I := 1 to Len doπ beginπ Buffer[I].X := Integer( ((XStep*I) shr 16) - ((XStep*(I-1)) shr 16) );π Buffer[I].Y := Integer( ((YStep*I) shr 16) - ((YStep*(I-1)) shr 16) );π end;πend;ππprocedure DrawPicLine( var Buffer; BitPlane: Integer;π StartX, StartY: Integer; Len: Integer; var LineBuf );πvarπ PD : Pointer;πbeginπ PD := Texture.Data; { pointer to unpacked screen image }π Port[$3C4] := 2;π if BitPlane = 0 thenπ Port[$3C5] := 3π elseπ Port[$3C5] := 12;ππ asmπ push dsπ mov bx,[StartX] { bx = StartX }π mov dx,[StartY] { dx = StartY }π les di,Buffer { ES:DI = @Screen }π add di,VPageLen/2-Hres/4 { calc target page }π mov cx,Len { Drawing buffer length }π lds si,PD { DS:SI = pointer to data }π push bp { store BP }π mov bp,word ptr LineBuf { BP = offset LineBuf }π cldπ@loop:π PUSH DXπ MOV AX,320π MUL DX { AX = StartY*320 }π POP DXππ PUSH BXπ ADD BX,AXπ mov al,[bx+SI]π POP BXππ stosbπ sub di,HRes/4+1{ add di,hres-1}π add BX,[bp]π ADD bp,2π add DX,[bp]π ADD bp,2ππ{ CMP BX,320π JB @@1π XOR BX,BXπ@@1: CMP DX,200π JB @@2π XOR DX,DXπ@@2:}π loop @loopππ pop bpπ pop dsπ end;πend;ππbeginππ{ Just imagine what can be if the next 8 lines would be more complex.π I'm working around it. }π{π (X1L,Y1L) (X2R,Y1R)π +---------------+π | |π | |π | |π +---------------+π (X2L,Y2L) (X2R,Y2R)ππ (X1LN,Y1LN) (X2RN,Y1RN)π +---------------+π | |π | |π | |π +---------------+π (X2LN,Y2LN) (X2RN,Y2RN)ππ}π X1L := 0;π Y1L := 0;π X2L := 0;π Y2L := WSY;π X1R := WSX;π Y1R := 0;π X2R := WSX;π Y2R := WSY;π{ I call Cos and Sin instead of using tables!? Yeah, I do. So what?π See comments near BuildLine ;-) }π{ I just rotate the rectangle corners, but why I do no more? }π X1RN := Round(π(X1R*Cos(2*Pi/RotateSteps*Angle)+Y1R*Sin(2*Pi/RotateSteps*Angle)) );π Y1RN := Round(π(Y1R*Cos(2*Pi/RotateSteps*Angle)-X1R*Sin(2*Pi/RotateSteps*Angle)) );π X1LN := Round(π(X1L*Cos(2*Pi/RotateSteps*Angle)+Y1L*Sin(2*Pi/RotateSteps*Angle)) );π Y1LN := Round(π(Y1L*Cos(2*Pi/RotateSteps*Angle)-X1L*Sin(2*Pi/RotateSteps*Angle)) );π X2RN := Round(π(X2R*Cos(2*Pi/RotateSteps*Angle)+Y2R*Sin(2*Pi/RotateSteps*Angle)) );π Y2RN := Round(π(Y2R*Cos(2*Pi/RotateSteps*Angle)-X2R*Sin(2*Pi/RotateSteps*Angle)) );π X2LN := Round(π(X2L*Cos(2*Pi/RotateSteps*Angle)+Y2L*Sin(2*Pi/RotateSteps*Angle)) );π Y2LN := Round(π(Y2L*Cos(2*Pi/RotateSteps*Angle)-X2L*Sin(2*Pi/RotateSteps*Angle)) );ππ XL := X+X1LN;π YL := Y+Y1LN;ππ BuildLine( Border, XL,YL, X+X2LN,Y+Y2LN, Size.X );π BuildLine( LineBuf, 0, 0, X1RN-X1LN, Y1RN-Y1LN, Size.Y );ππ{π The only thing that can be optimized is the loop below. I think it shouldπ be completely in asm.π}π for I := 1 to Size.X doπ beginπ DrawPicLine( PBuffer(@Screen)^[CurPage*VPageLen+(I-1) shr 1],π (I-1) {mod 2} and 1, XL, YL, Size.Y, LineBuf );π{π Inc( XL, Border[I].X );π Inc( YL, Border[I].Y );π}π asmπ mov di,Iπ shl di,2π mov ax,word ptr border[di]-4π add XL,axπ mov ax,word ptr Border[di]-4+2π add YL,axπ end;π end;πend;ππprocedure TRotateApp.Run;πvarπ C: Char;πbeginπ repeatπ if KeyPressed thenπ beginπ C := ReadKey;π if C = #0 then C := ReadKey;π case C ofπ #72: Move(0,-10);π #80: Move(0,-10);π #75: Move(-10,0);π #77: Move(10,0);π #81: Rotate(1);π #79: Rotate(-1);π '+': Scale(1+ScaleStep);π '-': Scale(1-ScaleStep);π #27: Exit;π end;π end;π Draw;π{ You can comment out the line below and do all transformation yourself }π Update;π FlipPage;π Inc( FramesNumber );π until False;πend;ππdestructor TRotateApp.Done;πbeginπ inherited Done;π WriteLn( 'Frames per second = ',π (FramesNumber / ((Time-StartTime)*0.055) ):5:2 );πend;ππvarπ RotateApp: TRotateApp;πbeginπ if not RotateApp.Init then Exit;π RotateApp.Run;π RotateApp.Done;πend.ππ{--------------------- UNIT CODE NEEDED HERE -------------------- }ππ{π VGA graphics unit.π Coded by Mike Shirobokov(MSH) aka Mad Max / Queue members.ππ This this the very small part of my gfx unit. I leave only functions usedπ by RotateApp.ππ Bugs corrected by Alex Grischenkoπ}ππunit VGAGraph;ππinterfaceππuses Objects, Memory;ππconstπ HRes = 360;π VRes = 320;π VPageLen = HRes*VRes div 4;ππ{ HRes = 320; VRes=200; Vpagelen=0;}ππtypeπ PBuffer = ^TBuffer;π TBuffer = array[ 0..65534 ] of Byte;π PScreenBuffer = ^TScreenBuffer;π TScreenBuffer = array[ 0..199, 0..319 ] of Byte;π TRGBPalette = array[ 0..255 ] of record R,G,B: Byte; end;ππ PImage = ^TImage;π TImage = object( TObject )π Size: TPoint;π Palette: TRGBPalette;π Data: PBuffer;π constructor Load( Name: String );π{ This procedures are now killed. If you need them just write me or seeπ old mail from me.π procedure Show( Origin: TPoint; var Buffer );π procedure ShowRect( Origin: TPoint; NewSize: TPoint; var Buffer ); }π destructor Done; virtual;π end;ππ PGraphApplication = ^TGraphApplication;π TGraphApplication = object( TObject )π constructor Init( ModeX : Boolean );π procedure Run; virtual;π destructor Done; virtual;π end;ππvarπ Screen: TScreenBuffer absolute $A000:0;ππ procedure SetPalette( var Pal: TRGBPalette );π procedure Set360x240Mode;π procedure ShowPage( Page: Integer );ππimplementationππuses PCX;ππconstructor TImage.Load( Name: String );πvarπ S: TDosStream;π I: Integer;π P: OldPCXPicture;π Len: Word;πbeginπ inherited Init;π P.Init( Name );π if P.Status <> pcxOK thenπ beginπ P.Done;π Fail;π end;π Size.X := P.H.XMax - P.H.XMin + 1;π Size.Y := P.H.YMax - P.H.YMin + 1;π{π I use DOS memory allocation 'cuz GetMem can't allocate 64Kπ Even thru DPMI. :-(π GetMem( Data, Word(Size.X) * Size.Y );π}π Len := Word((LongInt(Size.X)*Size.Y+15) div 16);π LEN:=65536 DIV 16;π asmπ mov ah,48hπ mov bx,Lenπ int 21hπ jnc @mem_okπ xor ax,axπ@mem_ok:π mov word ptr es:[di].Data+2,axπ xor ax,axπ mov word ptr es:[di].Data,axπ end;ππ if Data = nil thenπ beginπ P.Done;π Fail;π end;ππ fillchar(Data^,len*16-1,0);ππ Move( P.Pal, Palette, SizeOf(Palette) );π for I := 0 to 255 doπ beginπ Palette[I].R := Palette[I].R shr 2;π Palette[I].G := Palette[I].G shr 2;π Palette[I].B := Palette[I].B shr 2;π end;ππ for I := 0 to Size.Y-1 doπ P.ReadLine( Data^[ Word(Size.X)*I ] );π P.Done;πend;ππdestructor TImage.Done;πbeginπ{π FreeMem( Data, Word(Size.X)*Size.Y );π}π asmπ mov ah,49hπ mov ax,word ptr es:[di].Data+2π mov es,axπ int 21hπ end;π inherited Done;πend;ππconstructor TGraphApplication.Init( ModeX : Boolean );πbeginπ Set360x240Modeπend;ππprocedure TGraphApplication.Run;πbeginπ Abstract;πend;ππdestructor TGraphApplication.Done;πbeginπ asmπ mov ax,3hπ int 10hπ end;πend;ππprocedure SetPalette( var Pal: TRGBPalette );πvarπ I : Integer;πbeginπ for I := 0 to 255 doπ beginπ Port[$3C8] := I;π Port[$3C9] := Pal[I].R;π Port[$3C9] := Pal[I].G;π Port[$3C9] := Pal[I].B;π end;πend;ππ{ Modified from public-domain mode set code by John Bridges. }ππconstπ SC_INDEX = $03c4; {Sequence Controller Index}π CRTC_INDEX = $03d4; {CRT Controller Index}π MISC_OUTPUT = $03c2; {Miscellaneous Output register}ππ{ Index/data pairs for CRT Controller registers that differ betweenπ mode 13h and mode X. }ππCRT_PARM_LENGTH = 17;πCRTParms : array [1..CRT_PARM_LENGTH] of Word = (ππ $6B00, { Horz total }π $5901, { Horz Displayed }π $5A02, { Start Horz Blanking }π $8E03, { End Horz Blanking }π $5E04, { Start H Sync }π $8A05, { End H Sync }π $0d06, {vertical total}π $3e07, {overflow (bit 8 of vertical counts)}π $ea10, {v sync start}π $8c11, {v sync end and protect cr0-cr7}π $df12, {vertical displayed}π $e715, {v blank start}π $0616, {v blank end}π $4209, {cell height (2 to double-scan)}π $0014, {turn off dword mode}π $e317, {turn on byte mode}π $2D13 {90 bytes per line}π);ππprocedure Set360x240Mode;πbeginπ asmπ mov ax,13h {let the BIOS set standard 256-color}π int 10h {mode (320x200 linear)}ππ mov dx,SC_INDEXπ mov ax,0604hπ out dx,ax {disable chain4 mode}π mov ax,0100hπ out dx,ax {synchronous reset while switching clocks}ππ mov dx,MISC_OUTPUTπ mov al,0E7hπ out dx,al {select 28 MHz dot clock & 60 Hz scanning rate}ππ mov dx,SC_INDEXπ mov ax,0300hπ out dx,ax {undo reset (restart sequencer)}ππ mov dx,CRTC_INDEX {reprogram the CRT Controller}π mov al,11h {VSync End reg contains register write}π out dx,al {protect bit}π inc dx {CRT Controller Data register}π in al,dx {get current VSync End register setting}π and al,7fh {remove write protect on various}π out dx,al {CRTC registers}π dec dx {CRT Controller Index}π cldπ mov si,offset CRTParms {point to CRT parameter table}π mov cx,CRT_PARM_LENGTH {# of table entries}π@SetCRTParmsLoop:π lodsw {get the next CRT Index/Data pair}π out dx,ax {set the next CRT Index/Data pair}π push cxπ mov cx,1000π@loop: loop @loopπ pop cxπ loop @SetCRTParmsLoopππ mov dx,SC_INDEXπ mov ax,0f02hπ out dx,ax {enable writes to all four planes}π mov ax,$A000{now clear all display memory, 8 pixels}π mov es,ax {at a time}π sub di,di {point ES:DI to display memory}π sub ax,ax {clear to zero-value pixels}π mov cx,VRes*HRes/4/2 {# of words in display memory}π rep stosw {clear all of display memory}π end;πend;ππprocedure ShowPage( Page: Integer );πbeginπ asmπ mov ax,VPageLenπ mul word ptr Pageπ mov bx,axππ mov dx,3d4hπ mov al,0chπ mov ah,bhπ out dx,axπ mov dx,3d4hπ mov al,0dhπ mov ah,blπ out dx,axπ{ Uncomment this waiting for retrace if you see flickering }π{π mov dx,3dahπ @@1: in al,dxπ test al,00001000bπ jz @@1π @@2: in al,dxπ test al,00001000bπ jnz @@2π}π end;πend;ππEnd.ππ{ -------------------------- UNIT CODE NEEDED HERE -------------}ππ{π 256 color PCX bitmaps handling unit.π NewPCXPicture object are removed to reduce traffic. If youπ need it just contact me or dig in old mail from me.π Coded by Mike Shirobokov(MSH) aka Mad Max / Queue Members.π Free sourceware.π}ππunit PCX;ππinterfaceππuses Objects;ππtypeπ TRGBPalette = array[ 0..255 ] of record R,G,B: Byte; end;ππ PCXHeader = recordπ Creator,π Version,π Encoding,π Bits: Byte;π XMin,π YMin,π XMax,π YMax,π HRes,π VRes: Integer;π Palette: array [ 1..48 ] of Byte;π VMode,π Planes: Byte;π BytesPerLine,π PaletteInfo,π SHRes,π SVRes: Word;π Dummy: array [0..53] of Byte;π end;ππconstπ pcxOK = 0;π pcxInvalidType = 1;π pcxNoFile = 2;ππtypeπ OldPCXPicture = objectπ H: PCXHeader;π S: TBufStream;π Pal: TRGBPalette;π Status: Integer;π constructor Init( AFileName: String );π procedure ReadLine( var Buffer );π function ErrorText: String;π destructor Done;π end;π{π NewPCXPicture = objectπ H: PCXHeader;π S: TBufStream;π Pal: TRGBPalette;π constructor Init( AFileName: String; HSize: Integer );π procedure WriteLine( var Buffer );π destructor Done;π end;π}πimplementationππtypeπ GetByteFunc = function: Byte;π ByteArr = array [0..65534] of Byte;π PByte = ^ByteArr;ππprocedure UnpackString( GetByte: GetByteFunc; var Dest; Size: Integer );πvarπ DestPtr: PByte;π Count: Integer;π B: Byte;π I: Integer;πbeginπ DestPtr := @Dest;π Count := 0;π while Count < Size doπ beginπ B := GetByte;π if B < $C0 thenπ beginπ DestPtr^[Count] := B;π Inc(Count);π endπ elseπ beginπ DestPtr^[Count] := GetByte;π for I := 0 to B-$C1 doπ DestPtr^[Count+I] := DestPtr^[Count];π Inc( Count, I+1 );π end;π end;πend;ππconstructor OldPCXPicture.Init( AFileName: String );πbeginπ S.Init( AFileName, stOpenRead, 2048 );π if S.Status <> stOk thenπ beginπ Status := pcxNoFile;π Exit;π end;π S.Read( H, SizeOf(H) );π if (H.Planes <> 1) or (H.Encoding <> 1) or (H.Bits <> 8 ) thenπ beginπ Status := pcxInvalidType;π Exit;π end;π S.Seek( S.GetSize - SizeOf(Pal) );π S.Read( Pal, SizeOf(Pal) );π S.Seek( SizeOf(H) );π Status := pcxOK;πend;ππvarπ __GetS__: PStream;ππfunction Get: Byte; far;πvarπ B: Byte;πbeginπ __GetS__^.Read( B, 1 );π Get := B;πend;ππprocedure OldPCXPicture.ReadLine( var Buffer );πbeginπ __GetS__ := @S;π UnpackString( Get, Buffer, H.BytesPerLine );πend;ππfunction OldPCXPicture.ErrorText: String;πbeginπ case Status ofπ pcxOK:π ErrorText := 'No errors';π pcxNoFile:π ErrorText := 'Can''t open file';π pcxInvalidType:π ErrorText := 'Only 8 bit PCXs are supported';π end;πend;ππdestructor OldPCXPicture.Done;πbeginπ S.Done;πend;ππend.ππ 17 08-24-9413:50ALL JENS LARSSON Grabbing Pixel Color SWAG9408 )D█ 6 ╓ {π GK> I have a slight problem. I have written a program that runs inπ GK> graphics mode ($13). I use the following routine to get whatπ GK> colour is at that pixel :-π GK> PixelColor := MEM[$A000:X + (Y*320)];π GK> This works fine, but it is rather slow. I was wondering ifπ GK> anybody knew how to do this faster?π}ππ Function PixColor(x, y : Word) : Byte; Assembler;π Asmπ push dsπ mov ax,0a000hπ mov ds,axπ mov ax,yπ shl ax,6π mov si,axπ shl ax,2π add si,axπ add si,xπ lodsbπ pop dsπ End;π 18 08-24-9413:50ALL MARCIN BORKOWSKI Landscape SWAG9408 ¿ù┬ 30 ╓ πuses crt;ππtype lrgarr = array[0..65534]of byte;ππconstπ pal : array[1..384]of byte =π (0,0,0,48,48,48,1,0,43,1,3,43,2,5,44,2,7,44,3,9,45,4,11,46,5,13,47,6,15,48,π 7,17,49,8,19,50,9,21,51,10,22,52,11,24,52,12,26,54,13,28,54,14,30,56,15,32,π 56,16,34,58,17,34,58,17,36,58,18,38,60,19,40,60,20,42,62,21,44,62,10,31,0,π 11,31,0,11,31,1,11,32,1,12,32,1,12,32,2,12,33,2,13,33,2,14,33,3,15,33,3,15,π 34,3,15,34,4,15,35,4,16,35,4,16,35,5,16,36,5,17,36,5,17,36,6,18,37,6,18,38,π 7,19,38,8,20,39,8,20,40,9,21,40,10,22,41,10,22,42,11,23,42,12,24,43,12,24,π 44,13,25,44,14,25,45,14,26,46,15,27,46,16,27,47,17,28,47,18,28,48,19,29,49,π 19,30,49,20,30,50,21,31,51,21,32,51,22,32,52,23,33,53,23,34,53,24,34,54,25,π 35,55,25,36,55,26,36,56,27,37,57,27,38,57,27,39,57,27,41,57,27,42,57,27,43,π 57,27,44,57,27,45,57,27,46,57,27,47,57,27,49,57,27,50,57,27,51,57,27,52,57,π 27,53,57,27,55,57,27,56,57,27,57,57,27,58,57,27,58,57,26,58,57,25,58,57,24,π 58,56,23,58,55,22,58,54,20,58,53,19,58,51,18,58,50,17,58,50,16,58,49,15,58,π 48,14,58,47,13,58,46,12,58,45,11,58,44,11,58,44,10,58,43,10,58,42,9,57,41,π 8,57,40,8,56,39,7,56,38,6,55,37,5,55,35,4,54,33,4,54,31,2,32,32,32,63,63,63,π 63,63,63,63,63,63,63,63,63,48,48,48,63,63,63,63,63,63);ππvarπ mp,scr : ^lrgarr;π rng : array[0..320]of byte;π dir,i,x,y : integer;ππfunction ncol(mc,n,dvd : integer): integer;πvar loc : integer;πbeginπ loc:=(mc+n-random(2*n)) div dvd; ncol:=loc;π if loc>250 then ncol:=250; if loc<5 then ncol:=5πend;ππprocedure plasma(x1,y1,x2,y2 : word);πvar xn,yn,dxy,p1,p2,p3,p4 : word;πbeginπ if (x2-x1<2) and (y2-y1<2) then EXIT;π p1:=mp^[256*y1+x1]; p2:=mp^[256*y2+x1]; p3:=mp^[256*y1+x2];π p4:=mp^[256*y2+x2]; xn:=(x2+x1) shr 1; yn:=(y2+y1) shr 1;π dxy:=5*(x2-x1+y2-y1) div 3;π if mp^[256*y1+xn]=0 then mp^[256*y1+xn]:=ncol(p1+p3,dxy,2);π if mp^[256*yn+x1]=0 then mp^[256*yn+x1]:=ncol(p1+p2,dxy,2);π if mp^[256*yn+x2]=0 then mp^[256*yn+x2]:=ncol(p3+p4,dxy,2);π if mp^[256*y2+xn]=0 then mp^[256*y2+xn]:=ncol(p2+p4,dxy,2);π mp^[256*yn+xn]:=ncol(p1+p2+p3+p4,dxy,4);π plasma(x1,y1,xn,yn); plasma(xn,y1,x2,yn);π plasma(x1,yn,xn,y2); plasma(xn,yn,x2,y2);πend;ππprocedure draw(xp,yp,dir : integer);πvar z,zobs,ix,iy,iy1,iyp,ixp,x,y,s,csf,snf,mpc,i,j : integer;πbeginπ fillchar(rng,sizeof(rng),200); zobs:=100+mp^[256*yp+xp];π csf:=round(256*cos(dir/180*pi)); snf:=round(256*sin(dir/180*pi));π fillchar(scr^,64000,0);π for iy:=yp to yp+55 doπ beginπ iy1:=1+2*(iy-yp); s:=4+300 div iy1;π for ix:=xp+yp-iy to xp-yp+iy doπ beginπ ixp:=xp+((ix-xp)*csf+(iy-yp)*snf) div 256;π iyp:=yp+((iy-yp)*csf-(ix-xp)*snf) div 256;π x:=160+360*(ix-xp) div iy1;π if (x>=0) and (x+s<=318) thenπ beginπ z:=mp^[256*iyp+ixp]; mpc:=z shr 1;π if z<47 then z:=46; y:=100+(zobs-z)*30 div iy1;π if (y<=199) and (y>=0) thenπ for j:=x to x+s doπ beginπ for i:=y to rng[j] do scr^[320*i+j]:=mpc;π if y<rng[j] then rng[j]:=yπ end;π end;π end;π end;π move(scr^,mem[$A000:0],64000);πend;ππbeginπ writeln('Use arrow keys to pan in/out left/right ... any key to continue ..');π readkey;π randomize; x:=0; y:=0; dir:=0; new(mp); fillchar(mp^,65535,0);π new(scr); mp^[$0000]:=128; plasma(0,0,256,256);π asm xor ax,ax; mov al,$13; int $10; end;π port[$3C8]:=0; for i:=1 to 384 do port[$3C9]:=pal[i];π repeatπ dir:=dir mod 360; draw(x,y,dir);π case readkey ofπ #0 : case readkey ofπ #75 : dec(dir,10);π #77 : inc(dir,10);π #72 : begin y:=y+round(4*cos(dir/180*pi));π x:=x+round(4*sin(dir/180*pi)); end;π #80 : begin y:=y-round(4*cos(dir/180*pi));π x:=x-round(4*sin(dir/180*pi)); end;π end;π #27 : begin asm xor ax,ax; mov al,$3; int $10; end; HALT endπ endπ until false;πend.π 19 08-24-9413:50ALL JONAS MALMSTEN plasma SWAG9408 Um. 22 ╓ {πYesterday I saw Bas' plasma routine. Real nice! But... a little slow I thoughtπso I improved it. Another thing, Bas, the bouble buffer didn't work on myπet4000, the bplptr never changed in your mode.ππWell, enjoy this new routine!π}ππprogram plasma;ππ{ bigscreenplasma, by Bas van Gaalen & Sven van Heel, Holland, PD }π{ Improved by GEM, Sweden (convertion to asm --> many times faster) }ππusesπ crt;ππconstπ vidseg:word=$a000;ππvarπ stab1,stab2:array[0..255+80] of byte;π x:word;ππprocedure setpal(c,r,g,b:byte); assembler;πasmπ mov dx,3c8hπ mov al,[c]π out dx,alπ inc dxπ mov al,[r]π out dx,alπ mov al,[g]π out dx,alπ mov al,[b]π out dx,alπend;ππbeginπ asmπ mov ax,0013hπ int 10hπ mov dx,03c4hπ mov ax,0604hπ out dx,axπ mov dx,03d4hπ mov ax,4609hπ out dx,axπ mov ax,0014hπ out dx,axπ mov ax,0e317hπ out dx,axπ mov es,vidsegπ xor di,diπ xor ax,axπ mov cx,16000π rep stoswπ end;π for x:=0 to 63 do beginπ setpal(x,x div 4,x div 2,x);π setpal(127-x,x div 4,x div 2,x);π setpal(127+x,20+x div 4,x div 2,x);π setpal(254-x,20+x div 4,x div 2,x);π end;π for x:=0 to 255+80 do beginπ stab1[x]:=round(sin(2*pi*x/255)*128)+128;π stab2[x]:=round(cos(2*pi*x/255)*128)+128;π end;π asmπ mov cl,50π mov ch,90π mov es,vidsegπ push bpπ @main:ππ{ mov dx,3c8h (* For checking rastertime *)π xor al,alπ out dx,alπ inc dxπ out dx,alπ out dx,alπ out dx,al}ππ mov dx,3dahπ @vert1:π in al,dxπ test al,8π jz @vert1π @vert2:π in al,dxπ test al,8π jnz @vert2ππ mov dx,3dah (* This is kinda rediculous! *)π @vert1b: (* I have to insert another vbl to slow it down.... *)π in al,dxπ test al,8π jz @vert1bπ @vert2b:π in al,dxπ test al,8π jnz @vert2bππ{ mov dx,3c8h (* For checking rastertime *)π xor al,alπ out dx,alπ mov al,30π inc dxπ out dx,alπ out dx,alπ out dx,al}ππ inc clπ inc chπ xor di,diπ mov bp,diπ @loooooop:π mov si,offset stab1π mov bx,bpπ add bl,clπ mov dl,[si+bx]π xor dh,dhπ mov bl,chπ mov al,[si+bx]π add si,dxπ mov bx,bpπ add bl,alπ mov bl,[bx+offset stab2]π mov bh,blπ mov dx,40π @again:π lodswπ add ax,bxπ stoswπ dec dxπ jnz @againπ cmp si,offset stab1[256]π jb @1π sub si,256π @1:π inc bpπ cmp bp,58π jne @loooooopπ in al,60hπ cmp al,1π jne @mainπ pop bpπ end;π textmode(lastmode);πend.ππ 20 08-24-9413:50ALL OLAF BARTELT VGA 640X480x16 SWAG9408 G%¿φ 11 ╓ {π NV> Could somebody tell me how to use mode 640x480x16? Iπ NV> don't mean using it with int 10, 'cause it's too slow,π NV> but writing directly to VGA memory. So how do I draw aπ NV> pixel and how do I read a pixel?πwell, you set the mode with:ππ ASM MOV AX, 12h; INT 10h; END;ππand then draw a pixel with: }ππPROCEDURE plot_640x480x16(x, y : WORD; c : BYTE); ASSEMBLER;πASMπ {$IFDEF DPMI}π MOV ES, SEGA000π {$ELSE}π MOV AX, $A000π MOV ES, AXπ {$ENDIF}π MOV DI, xπ MOV CX, DIπ SHR DI, 3π MOV AX, 80π MUL yπ ADD DI, AXπ AND CL, $07π MOV AH, $80π SHR AH, CLπ MOV AL, $08π MOV DX, $03CEπ OUT DX, AXπ MOV AL, cπ MOV AH, [ES:DI]π MOV [ES:DI], ALπEND;πππ{ and read a pixel with: }πππFUNCTION point_640x480x16(x, y : WORD) : BYTE; ASSEMBLER;πASMπ MOV AX, 80π MUL yπ MOV SI, xπ MOV CX, SIπ SHR SI, 3π ADD SI, AXπ AND CL, $07π XOR CL, $07π MOV CH, 1π SHL CH, CLπ {$IFDEF DPMI}π MOV ES, SEGA000π {$ELSE}π MOV AX, $A000π MOV ES, AXπ {$ENDIF}π MOV DX, $03CEπ MOV AX, 772π XOR BL, BLπ@gp1:π OUT DX, AXπ MOV BH, ES:[SI]π AND BH, CHπ NEG BHπ ROL BX, $0001π DEC AHπ JGE @gp1π MOV AL, BLπEND;ππ 21 08-24-9413:51ALL LUIS MEZQUITA Moving Poligon SWAG9408 åMká 76 ╓ {πPS> I see that a lot of people around here have polygon, texture mapping andπPS> 3D routines so why don't you all post them here, even if you alreadyπPS> have done in the past cause there are people who didn't get themπPS> and want them :)π}ππ{$G+,R-}πProgram Polygoned_and_shaded_objects;ππ{ Mode-x version of polygoned objects }π{ Originally by Bas van Gaalen & Sven van Heel }π{ Optimized by Luis Mezquita Raya }ππuses Crt,x3Dunit2;π { ^^^^^ Contained in GRAPHICS.SWG file }π{$DEFINE Object1} { Try an object between 1..4 }ππconstππ{$IFDEF Object1} { Octagon }π nofpolys=9; { Number of poligons-1 }ππ nofpoints=11; { Number of points-1 }ππ polypoints=4; { Number of points for each poly }ππ sc=5; { Number of visible planes }ππ cr=23; { RGB components }π cg=8;π cb=3;ππ point:array[0..nofpoints,0..2] of integer=(π (-20,-20, 30),( 20,-20, 30),( 40,-40, 0),( 20,-20,-30),π (-20,-20,-30),(-40,-40, 0),(-20, 20, 30),( 20, 20, 30),π ( 40, 40, 0),( 20, 20,-30),(-20, 20,-30),(-40, 40, 0));ππ planes:array[0..nofpolys,0..3] of byte=(π (0,1,7,6),(1,2,8,7),(9,8,2,3),(10,9,3,4),(10,4,5,11),π (6,11,5,0),(0,1,2,5),(5,2,3,4),(6,7,8,11),(11,8,9,10));π{$ENDIF}ππ{$IFDEF Object2} { Cube }π nofpolys=5; { Number of poligons-1 }ππ nofpoints=7; { Number of points-1 }ππ polypoints=4; { Number of points for each poly }ππ sc=3; { Number of visible planes }ππ cr=0; { RGB components }π cg=13;π cb=23;ππ point:array[0..nofpoints,0..2] of integer=(π (-40,-40, 40),( 40,-40, 40),( 40,-40,-40),(-40,-40,-40),π (-40, 40, 40),( 40, 40, 40),( 40, 40,-40),(-40, 40,-40));ππ planes:array[0..nofpolys,0..3] of byte=(π (0,1,5,4),(1,5,6,2),(6,7,3,2),π (7,3,0,4),(0,1,2,3),(6,5,4,7));π{$ENDIF}ππ{$IFDEF Object3} { Octahedron }π nofpolys=7; { Number of poligons-1 }ππ nofpoints=5; { Number of points-1 }ππ polypoints=3; { Number of points for each poly }ππ sc=4; { Number of visible planes }ππ cr=0; { RGB components }π cg=3;π cb=23;ππ point:array[0..nofpoints,0..2] of integer=(π ( 0, 0, 45),(-40,-40, 0),(-40, 40, 0),( 40, 40, 0),π ( 40,-40, 0),( 0, 0,-45));ππ planes:array[0..nofpolys,0..3] of byte=(π (0,1,2,0),(0,2,3,0),(0,3,4,0),(0,4,1,0),π (5,1,2,5),(5,2,3,5),(5,3,4,5),(5,4,1,5));ππ{$ENDIF}ππ{$IFDEF Object4} { Spiky }π nofpolys=15; { Number of poligons-1 }ππ nofpoints=19; { Number of points-1 }ππ polypoints=4; { Number of points for each poly }ππ sc=5; { Number of visible planes }ππ cr=23; { RGB components }π cg=5;π cb=5;ππ point:array[0..nofpoints,0..2] of integer=(π (-10,-10, 30),( 10,-10, 30),( 30,-30, 0),( 10,-10,-30),π (-10,-10,-30),(-30,-30, 0),(-10, 10, 30),( 10, 10, 30),π ( 30, 30, 0),( 10, 10,-30),(-10, 10,-30),(-30, 30, 0),π ( -2, -2, 60),( -2, 2, 60),( 2, -2, 60),( 2, 2, 60),π ( -2, -2,-60),( -2, 2,-60),( 2, -2,-60),( 2, 2,-60));ππ planes:array[0..nofpolys,0..3] of byte=(π (0,1,14,12),(7,15,13,6),(1,14,15,7),(6,13,12,0),π (1,2,8,7),(9,8,2,3),π (10,9,19,17),(10,4,16,17),(3,4,16,18),(3,9,19,18),π (10,4,5,11),π (6,11,5,0),(0,1,2,5),(5,2,3,4),(6,7,8,11),(11,8,9,10));π{$ENDIF}ππtype polytype=array[0..nofpolys] of integer;π pointype=array[0..nofpoints] of integer;ππ ptnode=word;π stack=ptnode;ππconst soplt=SizeOf(polytype);π sopit=SizeOf(pointype);π xst:integer=1;π yst:integer=1;π zst:integer=-2;ππvar polyz,pind:array[byte] of polytype;π xp,yp:array[byte] of pointype;π phix:byte;ππProcedure QuickSort(lo,hi:integer); assembler; { Iterative QuickSort }πvar i,j,x,y:integer; { NON RECURSIVE }πasmπ mov ah,48h { Init stack }π mov bx,1π int 21hπ jc @exitπ mov es,axπ xor ax,axπ mov es:[4],axππ mov cx,lo { Push(lo,hi) }π mov dx,hiπ call @Pushππ@QS: mov ax,es:[4] { ¿Stack empty? }π and ax,axπ jz @Emptyππ mov cx,es:[0] { Top(lo,hi) }π mov dx,es:[2]π mov lo,cxπ mov hi,dxππ mov bx,es:[4] { Pop }π mov ah,49hπ int 21hπ jc @exitπ mov es,bxππ mov ax,cx { ax:=(i+j) div 2 }π mov bx,dxπ add ax,bxπ shr ax,1ππ lea bx,polyz { ax:=polyz[ax] }π call @indexπ mov x,axππ@Rep: mov ax,cx { repeat ... }π lea bx,polyz { while polyz[i]<x do ... }π call @indexπ cmp ax,xπ jge @Rep2π inc cx { inc(i); }π jmp @Repππ@Rep2: mov ax,dx { while x<polyz[j] do ... }π call @indexπ cmp x,axπ jge @EndRπ dec dx { dec(j); }π jmp @Rep2ππ@EndR: cmp cx,dx { if i>j ==> @NSwap}π jg @NBlππ je @NSwapπ push cxππ mov ax,cxπ call @indexπ mov cx,ax { cx:=polyz[i] }π mov si,diππ mov ax,dx { polyz[i]:=polyz[j] }π call @indexπ mov [si],axππ mov [di],cx { polyz[j]:=cx }π pop axππ push axπ lea bx,pindπ call @indexπ mov cx,ax { cx:=pind[i] }π mov si,diππ mov ax,dx { pind[i]:=pind[j] }π call @indexπ mov [si],axππ mov [di],cx { pind[j]:=cx }ππ pop cxπ@NSwap: inc cxπ dec dxππ@NBl: cmp cx,dx { ... until i>j; }π jle @Repππ mov i,cxπ mov j,dxππ mov dx,hi { if i>=hi ==> @ChkLo }π cmp cx,dxπ jge @ChkLoππ call @Push { Push(i,hi) }ππ@ChkLo: mov cx,lo { if lo>=j ==> @QSend }π mov dx,jπ cmp cx,dxπ jge @QSendππ call @Push { Push(lo,j) }ππ@QSend: jmp @QS { loop while stack isn't empty }ππ@Empty: mov ah,49hπ int 21hπ jmp @exitππ@index: shl ax,1 { ax:=2*ax }π add ax,bxπ mov di,axπ push bxπ mov bl,sopltπ mov al,phixπ xor ah,ahπ mul blπ add di,ax { di=2*index+SizeOf(polytype)+polyz }π pop bxπ mov ax,[di]π retππ@Push: mov ah,48h { Push into stack }π mov bx,1π int 21hπ jc @exitπ mov bx,esπ mov es,axπ mov es:[0],cxπ mov es:[2],dxπ mov es:[4],bxπ mov di,axπ retππ@exit:πend;ππProcedure Calc;πvar z:pointype;π spx,spy,spz,π cpx,cpy,cpz,π zd,x,y,i,j,k:integer;π n,key,phiy,phiz:byte;πbeginπ phix:=0;π phiy:=0;π phiz:=0;π FillChar(xp,sizeof(xp),0);π FillChar(yp,sizeof(yp),0);ππ repeatππ spx:=sinus(phix); { 'Precookied' constanst }π spy:=sinus(phiy);π spz:=sinus(phiz);ππ cpx:=cosinus(phix);π cpy:=cosinus(phiy);π cpz:=cosinus(phiz);ππ for n:=0 to nofpoints doπ beginπ i:=(cpy*point[n,0]-spy*point[n,2]) div divd;π j:=(cpz*point[n,1]-spz*i) div divd;π k:=(cpy*point[n,2]+spy*point[n,0]) div divd;π x:=(cpz*i+spz*point[n,1]) div divd;π y:=(cpx*j+spx*k) div divd;π z[n]:=(cpx*k-spx*j) div divd;π zd:=z[n]-dist;π xp[phix,n]:=(160+cpx)-(x*dist) div zd;π yp[phix,n]:=(200+spz) div 2-(y*dist) div zd;π end;ππ for n:=0 to nofpolys doπ beginπ polyz[phix,n]:=(z[planes[n,0]]+z[planes[n,1]]+π z[planes[n,2]]+z[planes[n,3]]) div 4;π pind[phix,n]:=n;π end;ππ QuickSort(0,nofpolys);π inc(phix,xst);π inc(phiy,yst);π inc(phiz,zst);π until phix=0;πend;ππProcedure ShowObject;πvar n:byte; pim:integer;πbeginπ retrace;π if address=0π then address:=16000π else address:=0;π setaddress(address);π cls;π for n:=sc to nofpolys doπ beginπ pim:=pind[phix,n];π polygon(xp[phix,planes[pim,0]],yp[phix,planes[pim,0]],π xp[phix,planes[pim,1]],yp[phix,planes[pim,1]],π xp[phix,planes[pim,2]],yp[phix,planes[pim,2]],π xp[phix,planes[pim,3]],yp[phix,planes[pim,3]],π polyz[phix,n]+30);π end;πend;ππProcedure Rotate;πvar i:byte;πbeginπ setmodex;π address:=0;π Triangles:=polypoints=3;π for i:=1 to 80 do setpal(i,cr+i shr 1,cg+i shr 1,cb+i shr 1);π setborder(63);π repeatπ ShowObject;π inc(phix,xst);π until KeyPressed;π setborder(0);πend;ππvar i:byte;π s:stack;π x,y:integer;ππbeginπ {border:=True;}π if ParamCount=1π then beginπ Val(ParamStr(1),xst,yst);π if yst<>0 then Halt;π zst:=-2*xst;π yst:=xst;π end;π WriteLn('Wait a moment ...');π Calc;π Rotate;π TextMode(LastMode);πend.ππ But ... wait a moment ... you also need x3dUnit2.pasπ which is also included in the SWAG filesπ 22 08-24-9413:56ALL SIMEON SPRY SCI File Viewer SWAG9408 ;{åµ 19 ╓ πProgram ViewASCi;ππ{ Simple SCi Viewer - By Simeon SpryππThis code will display a SCi (320*200*256) file. I would reccomend that youπadd code to find out if the SCi File name is valid. I had some, but I gotπit out of a book so it *might* be copyrighted :-(. You also might want toπsave the old pallete and restore it afterwards I didn't do it because Iπlost my reference.ππThis may be freely distributed, if you incorporate any portions of thisπcode into a part of anything you MUST give me some credit.π}πππProcedure ViewSci( SciF : STRING);π CONST Header : Array[1..4] OF CHAR = ('R','I','X','3');ππ VAR SciFile : File;π HeaderBuf : Array[1..10] OF CHAR;π NewPal : Array[1..768] OF BYTE; { 3 Bytes Per colour, 3*256 = 768}π OldPal : Array[1..768] OF BYTE; { " " "}π Screen : Array[1..64000] OF BYTE ABSOLUTE $A000:0000; { Direct toπthe screen }π i : integer;π Procedure SetPal(Pallete : Array OF BYTE);π VARπ PalPtr : POINTER;π BEGINπ PalPtr := @Pallete;π asmπ mov ax,1012hπ xor bx,bxπ mov cx,0100hπ les dx,PalPtrπ int 10hπ end;π END;ππ Procedure WaitForKey;assembler;π ASMπ xor ax,axπ int 16hπ END;πProcedure SetMode(Mode : BYTE); assembler;π ASMπ mov ah, 00π mov al, modeπ int 10hπ END;ππ BEGINπ { Open The File }π assign(SciFile, SciF);π Reset(SciFile,1);ππ { Check The Header }π BlockRead(SciFile,HeaderBuf,SizeOF(HeaderBuf));π For i := 1 to 4 DOπ Beginπ If HeaderBuf[i] <> Header[i] Thenπ BEGINπ WriteLn;π WriteLn(' Invalid SCI File. ');π WriteLn;π Halt(1);π END;π End;ππ { Set Mode $13 }π SetMode($13);ππ { Read Pallete into a 768 Byte Buffer & DisPlay. }π BlockRead(SciFile,NewPal,768);π SetPal(NewPal);ππ { Read 64000 bytes then write DIRECTLY to Video Memory }π BlockRead(SCIFile,Screen,64000);π cLOSE(SCIFILE);π { Wait Until Key Pressed }π WaitForKey;ππ { Set Text Mode }π SetMode($3);πEND;ππVar SciFile : String[12];ππBEGINπ { Ask For File To View }π WriteLn('SCi Viewer - By Simeon Spry');π Write('View File: ');π ReadLn(SciFile);ππ { View SCi File }π ViewSCI( SciFile );ππ { Display Made-By Message }π WriteLn('Simple SCi Viewer by Simeon Spry');π WriteLn;πEND.π 23 08-24-9413:56ALL BAS VAN GAALEN Scroll Bars SWAG9408 Ω╠E▒ 36 ╓ USES dos, crt;ππCONSTπ v_vidseg : WORD = $B800; { $B000 for mono }π v_columns : BYTE = 80; { Number of CRT columns }ππVARπ x : BYTE;π{πthe dspat routine, as you can see. Displays a string QUICKLYπIf 'Col' (=columns, NOT color) is negative (-1) the centence will be centered.πWorks also in exotic screenmodes, like 132x44, 100x44 or whatever you like.π}πprocedure dspat(Str : string; Col : integer; Row,Attr : byte); assembler;πasmπ push ds { Save Turbo's DS }π mov es,v_vidseg { Place VideoBuffer in es }π xor dh,dh { Clear DH }π mov dl,v_columns { Bytes per row }ππ lds si,Str { DS:SI pts to Str }π xor cx,cx { clear CX }π mov cl,[si] { String len counted in CX }π jcxz @l5 { If null, quit }π inc si { Point DS:SI to first char }ππ mov ax,Col { Get Column value }π cmp ax,0π jge @l6 { Absolute, or centered? }ππ mov ax,dxπ sub ax,cx { Substract stringlen from total }π shr ax,1 { Centre}ππ @l6:π mov di,axπ shl di,1 { Double for attributes }ππ mov al,Row { Get Row value }π mul dl { Times rows }π shl ax,1ππ add di,ax { ES:DI pts to lst pos }π cld { Direction flag forward }π mov ah,Attr { Get Attribute }π @l1:π lodsb { Get a character}π stosw { Write it with attribute }π loop @l1 { Go do next }π @l5:π pop ds { Restore DS and quit }πend;ππprocedure filltext(Dir : char; X1,Y1,X2,Y2,Col : byte); assembler;πasmπ push ds { Save Turbo's DS }ππ xor dh,dh { Clear DH }π mov dl,v_columns { Bytes per row (number of columns) }ππ xor ah,ahπ mov es,v_vidseg { Place VideoBuffer in ES and DS }π mov al,[X1]π mov di,axπ shl di,1 { Double for attributes }π mov al,[Y1] { Get Row value }π mul dl { Times rows }π shl ax,1π add di,ax { ES:DI pts to upperleft corner }ππ xor ch,chπ mov cl,[X2]π inc clπ sub cl,[X1] { Number of bytes to move in CL (columns) }π xor bh,bhπ mov bl,[Y2]π inc blπ sub bl,[Y1] { Number of rows to move in BL }ππ sub dl,[X2] { Substract right site }π dec dlπ shl dx,1 { Times two for attribs }π xor ah,ah { Clear AH }π mov al,[X1] { Left site }π shl ax,1 { Times two for attribs }π add dx,ax { Calculated difference between last col - first col }ππ mov al,[Dir]π mov ah,[Col]ππ cld { Direction flag forward }π @L1:π push cxπ rep stoswπ pop cxπ add di,dxπ dec blπ jnz @L1ππ pop ds { Restore DS and quit }πend;ππ{ Displays Veritical scrollbar }πprocedure ScrollBar(BarXPos,π BarYPos : byte;π CurPos,π ScrLen, { max screen row }π NofItems : word;π ColAttr : byte);πvar barpos,maxpos : word;πbeginπ dspat(#30,barxpos,barypos,colattr);π dspat(#31,barxpos,barypos+scrlen-1,colattr);π filltext('▒',barxpos,barypos+1,barxpos,barypos+scrlen-2,colattr);π if nofitems >= 1 then beginπ maxpos := scrlen-3;π if nofitems <> 1 then barpos := round(((curpos-1)/(nofitems-1))*maxpos)π else barpos := 0;π dspat('■',barxpos,barypos+barpos+1,colattr);π end;πend; { ScrollBar }ππBEGIN { demo coded by Gayle Davis for SWAG 8/18/94 }ππ ClrScr;π { put at col 40 of Row x, 3rd item selected }ππ FOR X := 1 to 24 DOπ BEGINπ ScrollBar(40,1,x,22,40,31);π DELAY(300);π END;ππEND.ππThe assembler stuff is nicely documented, so shouldn't be a problem. What'sπmissing here, you can define as constants at the top of your source, or try toπfind out using interrupt-calls or whatever...ππBtw: these routines are taken from my very private video-unit, and seem to workπon many different configurations (so far...) But that's also due to the factπthat the v_columns is found through some interrupt-calls and stuff...πThe routines work also in 132x44 or whatever strange video-mode.ππAnother point of discussion: no snow-checking is performed. I got in someπanoying discussions about this, because (imho) CGA's are hardly used theseπdays. So it seems a little ... nuts ... to make support for that hand full ofπCGA-users. Ah well, enclose the sc yourself. it's not hard, but it REALY slow'sπstuff down. And these routines were designed with SPEED as first concern andπcompatibily with MODERN hardware as a second...ππ _ _π|_] | _π|__].|__].π 24 08-24-9413:56ALL JENS LARSSON Scrolling Images SWAG9408 »ƒm 18 ╓ {πMichael, you wondered how you could scroll an image (320*200) over theπscreen. And yes, as you probably have figured out, the most reliableπsolution to that is mode-x (or tweaked mode or whatever...).πHere's an example program:ππ--------------------------------------------------------->8-------------------π{ππ Mode-x scrolling, by Jens Larsson 2:201/2120.3, Sweden, PD.π ( btw, hope you know some assembly... <g> )ππ}π{$G+}πUses Crt;ππ Var i, ScrBase : Word;ππ Procedure PutPix(x, y : Word; Color : Byte); Assembler;π Asmπ mov ax,0a000hπ mov es,axπ mov bx,xπ mov dx,3c4hπ mov ax,0102hπ mov cl,blπ and cl,3π shl ah,clπ out dx,axπ mov ax,yπ shl ax,4π mov di,axπ shl ax,2π add di,axπ shr bx,2π add di,bxπ add di,ScrBaseπ mov al,Colorπ mov es:[di],alπ End;ππ Procedure ScrPan(ScrOfs : Word); Assembler;π Asmπ mov bx,ScrOfsπ mov dx,3d4hπ mov ah,bhπ mov al,0chπ out dx,axπ mov ah,blπ inc alπ out dx,axπ End;ππ Procedure SetModeX; Assembler;π Asmπ mov ax,0012hπ int 10hπ mov ax,0013hπ int 10hπ mov dx,3c4hπ mov ax,0604hπ out dx,axπ mov dx,3d4hπ mov ax,0014hπ out dx,axπ mov ax,0e317hπ out dx,axπ End;ππ Procedure Synk; Assembler;π Asmπ mov dx,3dahπ@L1:π in al,dxπ test al,08hπ jne @L1π@L2:π in al,dxπ test al,08hπ je @L2π End;ππ Beginπ Randomize;π SetModeX;π ScrBase := 200*80;π For i := 0 to 9999 do PutPix(Random(320),Random(200),Random(256));π For i := 0 to 200 do Beginπ ScrPan(i*80);π Synk;π End;π ReadKey;π Asm; mov ax,0003h; int 10h; End;π End.ππ 25 08-24-9413:58ALL JOHN HOWARD Sprite Game SWAG9408 ▀î/{ 94 ╓ πprogram SpriteGame; {Verifies a VGA is present}π{$G+,R-}π(* jh Syntax: spritegame.exe [number]π optional number is the total population of sprites. Default is maxsprites.π*)π{ Original Sprites program by Bas van Gaalen, Holland, PD }π{ Modified by Luis Mezquita Raya }π{ Modified by John Howard (jh) into a game }π{ 30-MAY-1994 jh Version 1.0π Now a game to see which sprite survives the longest.π Renamed tScrArray to Screen, and tSprArray to SpriteData.π Removed CRT unit & saved around 1616 bytes. Added command line parameter.π Added timer and energy definitions to provide statistics.π 21-JUN-1994 jh Version 1.1 = ~7.5kπ Added OnlyVGA and SetMode procedures. Added CharSet & CharType definitions.π Implemented characters as sprites.π 29-JUN-1994 jh Version 1.2 = ~8.5k due to command line helpπ Places identification on each sprite by using HexDigits. CharColor defaultsπ to sprite number (0..maxsprites) as a color index in the palette. Fixed bugπ in moire background screen limits.π}πconstπ maxsprites=128; { Number of sprites is [1..128] }π pxsize=320; { screen x-size }π pysize=200; { screen y-size }π xsize=32; { sprite x-size }π ysize=32; { sprite y-size }π CharRows=8; { Characters are 8 rows high }π HexDigits : ARRAY[0..15] OF Char = '0123456789ABCDEF';ππtypeπ Screen=array[0..pysize-1, 0..pxsize-1] of byte;π pScreen=^Screen;π SpriteData=array[0..ysize-1, 0..xsize-1] of byte;π pSpriteData=^SpriteData;π SprRec=recordπ x,y : word; {Absolute location of sprite}π xspd,yspd : shortint; {Velocity horizontal and vertical}π energy : shortint; {Hide is neg., dead is 0, show is pos.}π buf : pSpriteData; {Rectangle of sprite definition}π end;π CharType = array[1..CharRows] of Byte;ππvarπ CharSet : array[0..255] of CharType absolute $F000:$FA6E;π sprite : array[1..maxsprites] of SprRec;π vidscr,virscr,bgscr : pScreen; {video, virtual, background screens}π dead : byte; {Counts the dead sprites}π survivor : byte; {Identify the last dead sprite}π Population : word; {Population from 1..128}π {CharColor : byte;} {Character digit color 0..255}ππ Timer : longint; {Stopwatch}π H, M, S, S100 : Word;π Startclock, Stopclock : Real;π mins, secs : integer;π Code: integer; {temporary result of VAL conversion}ππprocedure GetTime(var Hr, Mn, Sec, S100 : word); assembler; {Avoids DOS unit}πasmπ mov ah,2chπ int 21hπ xor ah,ah {fast register clearing instead of MOV AH,0}π mov al,dlπ les di,S100π stoswπ mov al,dhπ les di,Secπ stoswπ mov al,clπ les di,Mnπ stoswπ mov al,chπ les di,Hrπ stoswπend;ππprocedure StartTimer;πbeginπ GetTime(H, M, S, S100);π StartClock := (H * 3600) + (M * 60) + S + (S100 / 100);πend;ππprocedure StopTimer;πbeginπ GetTime(H, M, S, S100);π StopClock := (H * 3600) + (M * 60) + S + (S100 / 100);π Timer := trunc(StopClock - StartClock);π secs := Timer mod 60; {Seconds remaining}π mins := Timer div 60; {Reduce into minutes}πend;πfunction KeyPressed : boolean; assembler; {Avoids unit CRT.KeyPressed}πasmπ mov ah,01h; int 16h; jnz @0; xor ax,ax; jmp @1;π@0: mov al,1π@1:πend;ππprocedure SetMode(M:byte); assembler;πasmπ mov ah,0; mov al,M; int 10h;πend;πprocedure SetPal(col,r,g,b:byte); assembler; {256 color palette}πasmπ mov dx,03c8hπ mov al,col {color}π out dx,alπ inc dxπ mov al,r {red component}π out dx,alπ mov al,g {green component}π out dx,alπ mov al,b {blue component}π out dx,alπend;πprocedure flip(srcscr, destscr : pScreen); assembler; {copy screen}πasmπ push dsπ lds si,srcscrπ les di,destscrπ mov cx,pxsize*pysize/2π rep movswπ pop dsπend;πprocedure cls(scr : pScreen); assembler; {clear screen}πasmπ les di,scr; xor ax,ax; mov cx,pxsize*pysize/2; rep stoswπend;πprocedure retrace; assembler;πasmπ mov dx,03dahπ@vert1: in al,dxπ test al,8π jnz @vert1π@vert2: in al,dxπ test al,8π jz @vert2πend;πprocedure PutSprite(var sprite: SprRec; virseg: pScreen); assembler;πasmπ push dsπ lds si,sprite { get sprite segment }π les di,virseg { get virtual screen segment }π mov ax,SprRec[ds:si].yπ shl ax,6π mov di,axπ shl ax,2π add di,ax { y*pxsize }π add di,SprRec[ds:si].x { y*pxsize+x }π mov dx,pxsize-xsize { number of pixels left on line }π lds si,SprRec[ds:si].bufπ mov bx,ysizeπ@l1: mov cx,xsizeπ@l0: lodsbπ or al,alπ jz @skip { check if transparent "Black" }π mov es:[di],al { draw it }π@skip: inc diπ dec cxπ jnz @l0π add di,dxπ dec bxπ jnz @l1π pop dsπend;πprocedure OnlyVGA; assembler;πasmπ @CheckForVga: {push es}π mov AH,1ah {Get Display Combination Code}π mov AL,00h {AX := $1A00;}π int 10h {Intr($10, Regs);}π cmp AL,1ah {IsVGA:= (AL=$1A) AND((BL=7) OR(BL=8))}π jne @NoVGAπ cmp BL,07h {VGA w/ monochrome analog display}π je @VgaPresentπ cmp BL,08h {VGA w/ color analog display}π je @VgaPresentπ @NoVGA:π mov ax,3 {text mode}π int 10hπ push csπ pop dsπ lea dx,@messageπ mov ah,9π int 21h {print $ terminated string}π mov ax,4c00hπ int 21h {terminate}π @message: db 'Sorry, but you need a VGA to see this!',10,13,24hπ @VgaPresent: {pop es}π {... After here is where your VGA code can execute}πend; {OnlyVGA}ππVAR n : byte; {sprite number}π hx,hy,i,j,k,np : integer;πBEGIN {PROGRAM}π {Get text from command line and convert into a number}π Val(ParamStr(1), Population, Code);π if (Code <> 0) {writeln('Bad number at position: ', Code);}π OR (Population <1) OR (Population > maxsprites) thenπ Population := maxsprites; {default}π if ParamStr(1) = '?' thenπ beginπ writeln('Howard International, P.O. Box 34633, NKC, MO 64116 USA');π writeln('1994 Freeware Sprite Game v1.2');π writeln('Syntax: spritegame.exe [number]');π writeln(' optional number is the total population of sprites (1 to 128)');π halt;π end;ππ {CharColor := Population;}π OnlyVGA;π SetMode($13); {320x200x256x1 plane}π Randomize;π vidscr := Ptr($A000,0);π New(virscr); cls(virscr); New(bgscr); cls(bgscr);π np := 128 div Population;π for i := 0 to Population-1 doπ begin {Define moire background pattern}π case i mod 6 ofπ 0:beginπ hx := 23; hy := i*np; n := 0;π end;π 1:beginπ hx := i*np; hy := 23; n := 0;π end;π 2:beginπ hx := i*np; hy := 0; n := 23;π end;π 3:beginπ hx := 23; hy := 0; n := i*np;π end;π 4:beginπ hx := 0; hy := 23; n := i*np;π end;π 5:beginπ hx:= 0; hy:= i*np; n := 23;π end;π end;π for j := 0 to np-1 doπ beginπ k := j shr 1;π SetPal(np*i+j+1, k+hx, k+hy, k+n);π end;π end;ππ for i := 1 to 127 do SetPal(127+i, i div 3, 20+i div 5, 20+i div 7);π for i := 0 to pxsize-1 do {jh bug! Reduce to legal screen limits}π for j := 0 to pysize-1 doπ bgscr^[j,i] := 128+ ABS(i*i - j*j) and 127;π(*π flip(bgscr, vidscr); {copy background to video}π {SetPal(?,r,g,b)} {force a visible text palette entry}π writeln('Sprite Game v1.2 '); {modify video}π flip(vidscr, bgscr); {copy video to background}π*)π hx := xsize shr 1;π hy := ysize shr 1;π for n := 1 to Population doπ beginπ with sprite[n] doπ beginπ x := 20+ random(280 - xsize);π y := 20+ random(160 - ysize);π xspd := random(6) - 3;π yspd := random(6) - 3;π energy := random(10); {punishes liberals}π if xspd=0 thenπ beginπ xspd := 1;π energy := random(20); {average life expectancy}π end;π if yspd=0 thenπ beginπ yspd := 1;π energy := random(40); {rewards conservatives}π end;π New(buf);π for i := 0 to xsize-1 doπ for j := 0 to ysize-1 doπ beginπ k := (i-hx) * (i-hx) + (j-hy) * (j-hy);π if (k< hx*hx) and (k> hx*hx div 16)π then buf^[j,i] := k mod np + np * (n-1)π else buf^[j,i] := 0; {CRT color "Black" is transparent}π end;π end; {with}π end; {for}ππ {jh Can store your own bitmap image in any sprite[n].buf^[j,i] such as: }π for i := 0 to xsize-1 doπ for j := 0 to ysize-1 doπ beginπ sprite[1].buf^[j,i] := j; {first sprite. Horizontal bars}π sprite[Population].buf^[j,i] := i; {last sprite. Vertical bars}π end;ππ {jh Get characters from default font and attach to sprites}π for i := 1 to CharRows doπ for j := 1 to CharRows doπ beginπ for n := 1 to Population doπ beginπ {first hex digit for current sprite}π if (CharSet[ord(HexDigits[n SHR 4]),i] shr (8-j) and 1 = 1) thenπ sprite[n].buf^[i,j] := n {CharColor}π elseπ sprite[n].buf^[i,j] := 0; {transparent}π {second hex digit for current sprite}π if (CharSet[ord(HexDigits[n AND $F]),i] shr (8-j) and 1 =1) thenπ sprite[n].buf^[i,j+CharRows] := n {CharColor}π elseπ sprite[n].buf^[i,j+CharRows] := 0; {transparent}π end;π(* {mark last sprite 'Z'}π sprite[Population].buf^[i,j] := CharSet[ord('Z'),i] shr (8-j) and 1; *)π end;ππ {jh Keep track of the last dead sprite and how old it was. }π StartTimer;π while not (KeyPressed or (dead=Population)) doπ beginπ flip(bgscr, virscr);π retrace;π dead := 0; {reset the sentinel}π for n := 1 to Population doπ with sprite[n] doπ beginπ if energy > 0 then PutSprite(sprite[n], virscr) {show(n)}π { else if energy < 0 then hide(n) }π else inc(dead);π inc(x,xspd);π if (x<10) or (x > (310 - xsize)) thenπ beginπ xspd := -xspd;π energy := energy - 1;π end;π inc(y,yspd);π if (y<10) or (y > (190 - ysize)) thenπ beginπ yspd := -yspd;π energy := energy - 1;π end;π end; {with}π flip(virscr, vidscr);π end; {while}ππ StopTimer;π survivor := 0;π for n := 1 to Population doπ begin {find last dead sprite with zero energy}π if sprite[n].energy = 0 then survivor := n;π Dispose(sprite[n].buf);π end;π Dispose(virscr); Dispose(bgscr);π SetMode($3); {resume text video mode 3h= 80x25x16 color}π writeln('Last dead sprite was # ', survivor, ' of ', Population);π writeln('Time of death was ', trunc(StopClock));π writeln('Life span was ', mins:2, ' Minute and ', secs:2, ' Seconds');πEND. {PROGRAM}π 26 08-24-9413:58ALL BAS VAN GAALEN More STAR-ROUTINE SWAG9408
Q╘≡ 19 ╓ {πHowdy all!ππBy request here's the stars-routine, the final update. ;-)πLimits: cpu-speed and conv.-memory. No others...ππ}πprogram _stars;π{ Done by Sven van Heel and Bas van Gaalen, Holland, PD }πuses crt;πconstπ f=6; nofstars=100; vidseg:word=$a000;π bitmask:array[0..1,0..4,0..4] of byte=(π ((0,0,1,0,0),(0,0,3,0,0),(1,3,6,3,1),(0,0,3,0,0),(0,0,1,0,0)),π ((0,0,6,0,0),(0,0,3,0,0),(6,3,1,3,6),(0,0,3,0,0),(0,0,6,0,0)));πtype starstruc=recordπ xp,yp:word; phase,col:byte; dur:shortint; active:boolean; end;πvar stars:array[1..nofstars] of starstruc;ππprocedure setpal(col,r,g,b : byte); assembler; asmπ mov dx,03c8h; mov al,col; out dx,al; inc dx; mov al,rπ out dx,al; mov al,g; out dx,al; mov al,b; out dx,al; end;ππprocedure retrace; assembler; asmπ mov dx,3dah; @vert1: in al,dx; test al,8; jz @vert1π @vert2: in al,dx; test al,8; jnz @vert2; end;ππvar i,x,y:word;πbeginπ asm mov ax,13h; int 10h; end;π for i:=1 to 10 do beginπ setpal(i,f*i,0,0); setpal(21-i,f*i,0,0); setpal(20+i,0,0,0);π setpal(30+i,0,f*i,0); setpal(51-i,0,f*i,0); setpal(50+i,0,0,0);π setpal(60+i,0,0,f*i); setpal(81-i,0,0,f*i); setpal(80+i,0,0,0);π setpal(90+i,f*i,f*i,0); setpal(111-i,f*i,f*i,0); setpal(110+i,0,0,0);π setpal(120+i,0,f*i,f*i); setpal(141-i,0,f*i,f*i); setpal(140+i,0,0,0);π setpal(150+i,f*i,f*i,f*i); setpal(171-i,f*i,f*i,f*i); setpal(170+i,0,0,0);π end;π randomize;π for i:=1 to nofstars do with stars[i] do beginπ xp:=0; yp:=0; col:=0; phase:=0;π dur:=random(20);π active:=false;π end;π repeatπ retrace; retrace;π {setpal(0,0,0,30);}π for i:=1 to nofstars do with stars[i] do beginπ dec(dur);π if (not active) and (dur<0) then beginπ active:=true; phase:=0; col:=30*random(6);π xp:=random(315); yp:=random(195);π end;π end;π for i:=1 to nofstars do with stars[i] doπ if active then beginπ for x:=0 to 4 do for y:=0 to 4 doπ if bitmask[byte(phase>10),x,y]>0 thenπ mem[vidseg:(yp+y)*320+xp+x]:=bitmask[byte(phase>10),x,y]+col+phase;π inc(phase);π if phase=20 then begin active:=false; dur:=random(20); end;π end;π setpal(0,0,0,0);π until keypressed;π textmode(lastmode);πend.π 27 08-24-9417:50ALL ERIC COOLMAN Another Fire Graphic SWAG9408 ╔V· 67 ╓ {πAC>I got my hands on Jare's fire code and thought it was pretty cool,πAC>so I made my own fire program. Although it didn't turn out like IπAC>thought it would (like Jare's) what I have is (at least I think so)πAC>something that looks more realistic.ππThis is kinda funny... just the other day I was looking at Jare's fireπcode, and did an 80x50 textmode version of it in C. I did a quick andπdirty conversion of it to Pascal so I could post it here for youπ(don't you feel special? <G>). The pascal version came out a bitπslower then my C version, although they are very similar. I haven'tπfigured out why though... most times I try this, both come out closeπto the same speed.ππ(********************************************************************π Fire by Eric Coolman (aka. Digitar/SKP), Simple Minded Softwareπ Much like Jare's (VangelisTeam) fire, but uses 80x50x16 text modeπ rather than 320x200x256 (which was "tweaked" to look like 80x50π text mode). Reference : FIRE.TXT by Phil Carlisle (aka Zoombapup,π CodeX) from PC Game Programmer's Encyclopedia (PCGPE10.ZIP) by Markπ Feldman and contributers (thanks for the great reads guys!).π Compiler : Turbo Pascal 6.0π Released to public domain, July 30, 1994.ππ NOTE: FirePalette will not get loaded if running under DESQviewπ with "VIRTUALIZE TEXTMODE" on (which will stop any paletteπ manipulation). To fix, go into setup for the DOSBOX, andπ under "VIRTUALIZE TEXT/GRAPHICS" mode, and set it to "N".π Also for DV, set "WRITES DIRECT TO SCREEN" to "Y"es.π********************************************************************)π}ππProgram tFire;ππconstπ MAXX = 80;π MAXY = 50;π { Our gradient firepalette (white/yellow/red/orange/slate/black) }π FirePal : array[0..3*16-1] of byte =π { [ HUES ] }π { RED GREEN BLUE }π { === ===== ==== }π ( { Normal Color }π 0, 0, 0, { BLACK }π 0, 5, 3, { BLUE }π 0, 6, 7, { GREEN }π 0, 7, 9, { CYAN }π 0, 8, 11, { RED }π 0, 9, 12, { MAGENTA }π 63, 13, 0, { BROWN }π 60, 4, 4, { LIGHTGRAY }π 63, 58, 21, { DARKGRAY }π 63, 59, 0, { LIGHTBLUE }π 63, 60, 0, { LIGHTGREEN }π 63, 60, 0, { LIGHTCYAN }π 63, 61, 30, { LIGHTRED }π 63, 55, 42, { LIGHTMAGENTA }π 63, 60, 55, { YELLOW }π 63, 63, 63 { WHITE }π );ππtypeπ ColorArray = array [0..MAXX+1, 0..MAXY] of Byte;πvarπ FireImage : ColorArray;π CUR : Word; { working color }π x, y : Byte; { general counters }ππ(*π Sets video mode. If mode is 64d (40h), 8x8 ROM font will be loadedπ and 80x50 textmode will be activated. Any other value will setπ mode normally.π*)πprocedure VidMode(mode : byte); assembler;πasmπ cmp mode, 40h { (64d) want 80x50/43 mode? }π jnz @normalsetπ mov ax,1112h { set 8 point font as current font }π mov bl,00hπ jmp @MakeItSo { ;-) }π @normalset:π mov ah, 00hπ mov al, modeπ @MakeItSo:π int 10hπend;ππ{ grabs and dumps keypress...returns 1 if a key was hit, else 0 }πfunction KbGrab : boolean;πvarπ WasHit : boolean;πbeginπ WasHit := False;ππ asmπ mov ax, 0100hπ int 16hπ lahfπ test ah, 40hπ jnz @doneπ inc WasHitπ mov ax, 0000h { grab the key they hit .... }π int 16hπ @done:π end;π KbGrab := WasHit;πend;ππ(*********************************************************************π sets only color indexes normally used in textmode (16 of 'em).π Note the heavy use of ternary operator there... what that meansπ is - indexes 7 to 15 (dark gray to white) are actually indexesπ 55 to 63, and index 6 (dark brown) is actually 20d (14h) becauseπ it uses the secondary hues so that it doesn't look too much likeπ red. The rest (0,1,2,4,5,7) are as expected.π*********************************************************************)πprocedure SetFirePal;πvarπ i, j : Byte;πbeginπ for i:= 0 to 16 do { for each index }π beginπ if i <= 7 then begin if i = 6 then j := 20 else j := i; endπ else j := i+48;π port[$3c8] := j; { Send the index }π port[$3c9] := FirePal[i*3]; { Send the red }π port[$3c9] := FirePal[i*3+1]; { Send the green }π port[$3c9] := FirePal[i*3+2]; { Send the blue }π end;πend;πππ(*********************************************************************π +----+-----+----+ Table to left are screen ofs's surrounding CUR(0).π |-81 | -80 |-79 | That we will take average of. 80 is for width ofπ +----+-----+----+ screen in chars in textmode (also width of ourπ | -1 | CUR | +1 | screen buffer). The calculated average will beπ +----+-----+----+ assigned to spot '-80' to move the fire upwards,π |+79 | +80 |+81 | and decremented to fade it out (like a plasmaπ +----+-----+----+ effect somewhat).π*********************************************************************)πprocedure DoFire;πbegin;π { start at [1,1] or above because 0,0 doesn't have 8 surrounding }π { stop x at 78 or less for the same reason (ending y doesn't }π { matter cause we are setting max y randomly anyways). }π { (starting y can be set to 8 to give room for a scroller). }π for y := 1 to MAXY doπ for x := 1 to MAXX-1 doπ beginπ { get average of 8 surrounding colors (-ofs-) }π CUR := ( FireImage[x-1][y] { direct to left (-1) }π + FireImage[x+1][y] { direct to right (+1) }π + FireImage[x][y-1] { direct above (-80) }π + FireImage[x][y+1] { direct below (+80) }π + FireImage[x-1][y-1] { above to left (-81) }π + FireImage[x+1][y+1] { below to right (+81) }π + FireImage[x+1][y-1] { above to right (-79) }π + FireImage[x-1][y+1] { below to left (+79) }π ) shr 3; { divide by 8 }π Dec(CUR); { make fire fade out }π { notice below is assigning the average CUR to (CUR-1 line) }π { ... this keeps fire moving in upward direction. }π FireImage[x][y-1] := CUR; { set color }π mem[$b800:y*160+(x shl 1)+1] := FireImage[x][y];π end;ππ { Randomly set last line of fire... This keeps the fire going }π for x := 0 to 80 doπ FireImage[x][49] := (random(255)+1);π { second last line also to give fire some more height. }π for x := 0 to 80 doπ FireImage[x][48] := (random(255)+1);πend;ππbeginπ VidMode($03); { 80x25 mode (to clear screen) }π VidMode($40); { 80x50 mode }ππ SetFirePal;ππ { change to hi-intense background so we have 16 bg colors to }π { work with. }π asmπ mov ax, 1003h { blinking attr }π mov bx, 0000h { 0=HiIntBackground, 1=Blinking Attr }π int 10hπ end;ππ { clear fire image }π fillchar(FireImage, sizeof(FireImage), 63); { fill with white }ππ for x := 0 to 80 do { set up last line to start the fire }π FireImage[x][49] := (random(255)+1);ππ repeat DoFire; until KbGrab;ππ VidMode($03); { 80x25 mode }πend.π 28 08-24-9417:53ALL DAVID DAHL Transparent 3D Vectors SWAG9408 ┬d 173 ╓ πProgram TrnsVect; { Transparent Vectors }π{$G+} { 286 Instructions Enabled }ππ{ Transparent 3D Vectors Example }π{ Programmed by David Dahl }π{ This program is PUBLIC DOMAIN }ππUses CRT;πConst ViewerDist = 200;πType VGAArray = Array [0..199, 0..319] of Byte;π VGAPtr = ^VGAArray;π PaletteRec = Recordπ Red : Byte;π Green : Byte;π Blue : Byte;π End;π PaletteType = Array [0..255] of PaletteRec;π PalettePtr = ^PaletteType;π PolyRaster = Recordπ X1 : Word;π X2 : Word;π End;π PolyFill = Array [0..199] of PolyRaster;π PolyFillPtr = ^PolyFill;π FacetPtr = ^PolyFacet;π PolyFacet = Recordπ Color : Byte;π X1, Y1, Z1,π X2, Y2, Z2,π X3, Y3, Z3,π X4, Y4, Z4 : Integer;π NextFacet : FacetPtr;π End;π PolyHPtr = ^PolygonHead;π PolygonHead = Recordπ X, Y, Z : Integer;π AX, AY, AZ : Integer;π FirstFacet : FacetPtr;π End;πVar VGAMEM : VGAPtr;π WorkPage : VGAPtr;π BkgPage : VGAPtr;π Palette : PalettePtr;π PolyList : PolyFillPtr;π{-[ Initialize 320 X 200 X 256 VGA ]---------------------------------------}πProcedure GoMode13h; Assembler;πASMπ MOV AX, $0013π INT $10πEnd;π{=[ Convex Polygon Drawing Routines ]======================================}π{-[ Clear Polygon Raster List ]--------------------------------------------}πProcedure ClearPolyList (Var ListIn : PolyFill);πBeginπ FillChar (ListIn, SizeOf(ListIn), $FF);πEnd;π{-[ OR VariableIn with Value -- Modeled after FillChar ]-------------------}πProcedure ORChar (Var VariableIn;π Size : Word;π Value : Byte); Assembler;πASMπ PUSH DSπ MOV CX, Sizeπ OR CX, CXπ JZ @Doneπ LDS SI, VariableInπ MOV AL, Valueπ @ORLoop:π OR DS:[SI], ALπ INC SIπ LOOP @ORLoopπ @Done:π POP DSπEnd;π{-[ Draw Polygon From Raster List To Work Buffer ]-------------------------}πProcedure DrawPolyFromList (Var ListIn : PolyFill;π Var FrameBuffer : VGAArray;π Color : Byte);πVar YCount : Word;π TempX1 : Word;π TempX2 : Word;πBeginπ For YCount := 0 to 199 doπ Beginπ TempX1 := ListIn[YCount].X1;π TempX2 := ListIn[YCount].X2;π If (TempX1 <= 319) AND (TempX2 <= 319)π Thenπ ORChar (FrameBuffer[YCount, TempX1],π TempX2 - TempX1 + 1, Color);π End;πEnd;π{-[ Add An Element To The Raster List ]------------------------------------}πProcedure AddRasterToPoly (Var ListIn : PolyFill;π X, Y : Integer);πBeginπ { Clip X }π If X < 0π Thenπ X := 0π Elseπ If X > 319π Thenπ X := 319;π { If Y in bounds, add to list }π If ((Y >= 0) AND (Y <= 199))π Thenπ Beginπ If (ListIn[Y].X1 > 319)π Thenπ Beginπ ListIn[Y].X1 := X;π ListIn[Y].X2 := X;π Endπ Elseπ If (X < ListIn[Y].X1)π Thenπ ListIn[Y].X1 := Xπ Elseπ If (X > ListIn[Y].X2)π Thenπ ListIn[Y].X2 := X;π End;πEnd;π{=[ Polygon ]==============================================================}π{-[ Add A Facet To Current Polygon ]---------------------------------------}πProcedure AddFacet (Polygon : PolyHPtr;π Color : Byte;π X1In, Y1In, Z1In : Integer;π X2In, Y2In, Z2In : Integer;π X3In, Y3In, Z3In : Integer;π X4In, Y4In, Z4In : Integer);πVar CurrentFacet : FacetPtr;πBeginπ If Polygon^.FirstFacet = Nilπ Thenπ Beginπ New(Polygon^.FirstFacet);π CurrentFacet := Polygon^.FirstFacet;π Endπ Elseπ Beginπ CurrentFacet := Polygon^.FirstFacet;π While CurrentFacet^.NextFacet <> Nil doπ CurrentFacet := CurrentFacet^.NextFacet;π New(CurrentFacet^.NextFacet);π CurrentFacet := CurrentFacet^.NextFacet;π End;π CurrentFacet^.Color := Color;π CurrentFacet^.X1 := X1In;π CurrentFacet^.X2 := X2In;π CurrentFacet^.X3 := X3In;π CurrentFacet^.X4 := X4In;π CurrentFacet^.Y1 := Y1In;π CurrentFacet^.Y2 := Y2In;π CurrentFacet^.Y3 := Y3In;π CurrentFacet^.Y4 := Y4In;π CurrentFacet^.Z1 := Z1In;π CurrentFacet^.Z2 := Z2In;π CurrentFacet^.Z3 := Z3In;π CurrentFacet^.Z4 := Z4In;π CurrentFacet^.NextFacet := Nil;πEnd;π{-[ Initialize a New Polygon ]---------------------------------------------}πProcedure InitializePolygon (Var PolyHead : PolyHPtr;π XIn, YIn, ZIn : Integer;π RollIn, PitchIn, YawIn : Integer);πBeginπ If PolyHead = Nilπ Thenπ Beginπ New(PolyHead);π PolyHead^.X := XIn;π PolyHead^.Y := YIn;π PolyHead^.Z := ZIn;π PolyHead^.AX := RollIn;π PolyHead^.AY := PitchIn;π PolyHead^.AZ := YawIn;π PolyHead^.FirstFacet := Nil;π End;πEnd;π{-[ Dispose Polygon ]------------------------------------------------------}πProcedure DisposePolygon (Var PolyHead : PolyHPtr);πVar TempPtr : FacetPtr;π TP2 : FacetPtr;πBeginπ TempPtr := PolyHead^.FirstFacet;π While TempPtr <> Nil doπ Beginπ TP2 := TempPtr^.NextFacet;π Dispose (TempPtr);π TempPtr := TP2;π End;π Dispose (PolyHead);π PolyHead := Nil;πEnd;π{-[ Rotate Polygon About Axies ]-------------------------------------------}πProcedure RotatePolygon (Var PolyHead : PolyHPtr;π DX, DY, DZ : Integer);πBeginπ INC (PolyHead^.AX, DX);π INC (PolyHead^.AY, DY);π INC (PolyHead^.AZ, DZ);π While (PolyHead^.AX > 360) doπ DEC(PolyHead^.AX, 360);π While (PolyHead^.AY > 360) doπ DEC(PolyHead^.AY, 360);π While (PolyHead^.AZ > 360) doπ DEC(PolyHead^.AZ, 360);π While (PolyHead^.AX < -360) doπ INC(PolyHead^.AX, 360);π While (PolyHead^.AY < -360) doπ INC(PolyHead^.AY, 360);π While (PolyHead^.AZ < -360) doπ INC(PolyHead^.AZ, 360);πEnd;π{=[ Graphics Related Routines ]============================================}π{-[ Build Facet Edge ]-----------------------------------------------------}πProcedure DrawLine (X1In, Y1In,π X2In, Y2In : Integer;π Color : Byte);πVar dx, dy : Integer;π ix, iy : Integer;π X, Y : Integer;π PX, PY : Integer;π i : Integer;π incc : Integer;π plot : Boolean;πBeginπ dx := X1In - X2In;π dy := Y1In - Y2In;π ix := abs(dx);π iy := abs(dy);π X := 0;π Y := 0;π PX := X1In;π PY := Y1In;π AddRasterToPoly (PolyList^, PX, PY);π If ix > iyπ Thenπ incc := ixπ Elseπ incc := iy;π i := 0;π While (i <= incc) doπ Beginπ Inc (X, ix);π Inc (Y, iy);π Plot := False;π If X > inccπ Thenπ Beginπ Plot := True;π Dec (X, incc);π If dx < 0π Thenπ Inc(PX)π Elseπ Dec(PX);π End;π If Y > inccπ Thenπ Beginπ Plot := True;π Dec (Y, incc);π If dy < 0π Thenπ Inc(PY)π Elseπ Dec(PY);π End;π If Plotπ Thenπ AddRasterToPoly (PolyList^, PX, PY);π Inc(i);π End;πEnd;π{-[ Draw Polygon ]---------------------------------------------------------}πProcedure DrawPolygon3D (PolyHead : PolyHPtr;π Buffer : VGAPtr);πVar CurrentFacet : FacetPtr;π CalcX1, CalcY1, CalcZ1,π CalcX2, CalcY2, CalcZ2,π CalcX3, CalcY3, CalcZ3,π CalcX4, CalcY4, CalcZ4 : Integer;π XPrime1, YPrime1, ZPrime1,π XPrime2, YPrime2, ZPrime2,π XPrime3, YPrime3, ZPrime3,π XPrime4, YPrime4, ZPrime4 : Integer;π Temp : Integer;π CTX, STX,π CTY, STY,π CTZ, STZ : Real;πBeginπ CurrentFacet := PolyHead^.FirstFacet;π While CurrentFacet <> Nil doπ With CurrentFacet^ doπ Beginπ ClearPolyList (PolyList^);π XPrime1 := X1; YPrime1 := Y1; ZPrime1 := Z1;π XPrime2 := X2; YPrime2 := Y2; ZPrime2 := Z2;π XPrime3 := X3; YPrime3 := Y3; ZPrime3 := Z3;π XPrime4 := X4; YPrime4 := Y4; ZPrime4 := Z4;π { Rotate Coords }π CTX := COS(PolyHead^.AX * PI / 180);π STX := SIN(PolyHead^.AX * PI / 180);π CTY := COS(PolyHead^.AY * PI / 180);π STY := SIN(PolyHead^.AY * PI / 180);π CTZ := COS(PolyHead^.AZ * PI / 180);π STZ := SIN(PolyHead^.AZ * PI / 180);π Temp := Round((YPrime1 * CTX) - (ZPrime1 * STX));π ZPrime1 := Round((YPrime1 * STX) + (ZPrime1 * CTX));π YPrime1 := Temp;π Temp := Round((XPrime1 * CTY) - (ZPrime1 * STY));π ZPrime1 := Round((XPrime1 * STY) + (ZPrime1 * CTY));π XPrime1 := Temp;π Temp := Round((XPrime1 * CTZ) - (YPrime1 * STZ));π YPrime1 := Round((XPrime1 * STZ) + (YPrime1 * CTZ));π XPrime1 := Temp;π Temp := Round((YPrime2 * CTX) - (ZPrime2 * STX));π ZPrime2 := Round((YPrime2 * STX) + (ZPrime2 * CTX));π YPrime2 := Temp;π Temp := Round((XPrime2 * CTY) - (ZPrime2 * STY));π ZPrime2 := Round((XPrime2 * STY) + (ZPrime2 * CTY));π XPrime2 := Temp;π Temp := Round((XPrime2 * CTZ) - (YPrime2 * STZ));π YPrime2 := Round((XPrime2 * STZ) + (YPrime2 * CTZ));π XPrime2 := Temp;π Temp := Round((YPrime3 * CTX) - (ZPrime3 * STX));π ZPrime3 := Round((YPrime3 * STX) + (ZPrime3 * CTX));π YPrime3 := Temp;π Temp := Round((XPrime3 * CTY) - (ZPrime3 * STY));π ZPrime3 := Round((XPrime3 * STY) + (ZPrime3 * CTY));π XPrime3 := Temp;π Temp := Round((XPrime3 * CTZ) - (YPrime3 * STZ));π YPrime3 := Round((XPrime3 * STZ) + (YPrime3 * CTZ));π XPrime3 := Temp;π Temp := Round((YPrime4 * CTX) - (ZPrime4 * STX));π ZPrime4 := Round((YPrime4 * STX) + (ZPrime4 * CTX));π YPrime4 := Temp;π Temp := Round((XPrime4 * CTY) - (ZPrime4 * STY));π ZPrime4 := Round((XPrime4 * STY) + (ZPrime4 * CTY));π XPrime4 := Temp;π Temp := Round((XPrime4 * CTZ) - (YPrime4 * STZ));π YPrime4 := Round((XPrime4 * STZ) + (YPrime4 * CTZ));π XPrime4 := Temp;π { Translate Coords }π XPrime1 := PolyHead^.X + XPrime1;π YPrime1 := PolyHead^.Y + YPrime1;π ZPrime1 := PolyHead^.Z + ZPrime1;π XPrime2 := PolyHead^.X + XPrime2;π YPrime2 := PolyHead^.Y + YPrime2;π ZPrime2 := PolyHead^.Z + ZPrime2;π XPrime3 := PolyHead^.X + XPrime3;π YPrime3 := PolyHead^.Y + YPrime3;π ZPrime3 := PolyHead^.Z + ZPrime3;π XPrime4 := PolyHead^.X + XPrime4;π YPrime4 := PolyHead^.Y + YPrime4;π ZPrime4 := PolyHead^.Z + ZPrime4;π { Translate 3D Vectorspace to 2D Framespace }π CalcX1 := 160 + ((LongInt(XPrime1)*ViewerDist) DIVπ (ZPrime1+ViewerDist));π CalcY1 := 100 + ((LongInt(YPrime1)*ViewerDist) DIVπ (ZPrime1+ViewerDist));π CalcX2 := 160 + ((LongInt(XPrime2)*ViewerDist) DIVπ (ZPrime2+ViewerDist));π CalcY2 := 100 + ((LongInt(YPrime2)*ViewerDist) DIVπ (ZPrime2+ViewerDist));π CalcX3 := 160 + ((LongInt(XPrime3)*ViewerDist) DIVπ (ZPrime3+ViewerDist));π CalcY3 := 100 + ((LongInt(YPrime3)*ViewerDist) DIVπ (ZPrime3+ViewerDist));π CalcX4 := 160 + ((LongInt(XPrime4)*ViewerDist) DIVπ (ZPrime4+ViewerDist));π CalcY4 := 100 + ((LongInt(YPrime4)*ViewerDist) DIVπ (ZPrime4+ViewerDist));π { Draw Shape }π DrawLine (CalcX1, CalcY1, CalcX2, CalcY2, Color);π DrawLine (CalcX2, CalcY2, CalcX3, CalcY3, Color);π DrawLine (CalcX3, CalcY3, CalcX4, CalcY4, Color);π DrawLine (CalcX4, CalcY4, CalcX1, CalcY1, Color);π DrawPolyFromList (PolyList^, WorkPage^, Color);π CurrentFacet := CurrentFacet^.NextFacet;π End;πEnd;π{-[ Build Background ]-----------------------------------------------------}πProcedure BuildBackground (Var BufferIn : VGAArray);πVar CounterX,π CounterY : Integer;πBeginπ For CounterY := 0 to 199 doπ For CounterX := 0 to 319 doπ BufferIn[CounterY, CounterX] := 1 + ((CounterY MOD 5) * 5) +π (CounterX MOD 5);πEnd;π{-[ Build Palette ]--------------------------------------------------------}πProcedure BuildPalette (Var PaletteOut : PaletteType);πConst BC = 16;πVar Counter1,π Counter2 : Integer;πBeginπ FillChar (PaletteOut, SizeOf(PaletteOut), 0);π For Counter1 := 0 to 4 doπ For Counter2 := 1 to 2 doπ Beginπ PaletteOut[1+(Counter1 * 5)+Counter2].Red := BC+(Counter2 * 5);π PaletteOut[1+(Counter1 * 5)+Counter2].Green := BC+(Counter2 * 5);π PaletteOut[1+(Counter1 * 5)+Counter2].Blue := BC+(Counter2 * 5);π PaletteOut[1+(Counter1 * 5)+4-Counter2].Red := BC+(Counter2 * 5);π PaletteOut[1+(Counter1 * 5)+4-Counter2].Green := BC+(Counter2 * 5);π PaletteOut[1+(Counter1 * 5)+4-Counter2].Blue := BC+(Counter2 * 5);π End;π For Counter1 := 0 to 4 doπ Beginπ If PaletteOut[1+(5 * 1)+Counter1].Red < BC + 5π Thenπ Beginπ PaletteOut[1+(5 * 1)+Counter1].Red := BC + 5;π PaletteOut[1+(5 * 1)+Counter1].Green := BC + 5;π PaletteOut[1+(5 * 1)+Counter1].Blue := BC + 5;π PaletteOut[1+(5 * 3)+Counter1].Red := BC + 5;π PaletteOut[1+(5 * 3)+Counter1].Green := BC + 5;π PaletteOut[1+(5 * 3)+Counter1].Blue := BC + 5;π End;π PaletteOut[1+(5 * 2)+Counter1].Red := BC + 10;π PaletteOut[1+(5 * 2)+Counter1].Green := BC + 10;π PaletteOut[1+(5 * 2)+Counter1].Blue := BC + 10;π End;π For Counter1 := 0 to 24 doπ Beginπ PaletteOut[32+Counter1].Red := ((PaletteOut[Counter1].Red* 8)+π (26 * 24)) DIV 32;π PaletteOut[32+Counter1].Green := ((PaletteOut[Counter1].Green* 8)+π (0 * 24)) DIV 32;π PaletteOut[32+Counter1].Blue := ((PaletteOut[Counter1].Blue* 8)+π (0 * 24)) DIV 32;π PaletteOut[64+Counter1].Red := ((PaletteOut[Counter1].Red* 8)+π (0 * 24)) DIV 32;π PaletteOut[64+Counter1].Green := ((PaletteOut[Counter1].Green* 8)+π (26 * 24)) DIV 32;π PaletteOut[64+Counter1].Blue := ((PaletteOut[Counter1].Blue* 8)+π (0 * 24)) DIV 32;π PaletteOut[128+Counter1].Red := ((PaletteOut[Counter1].Red* 8)+π (0 * 24)) DIV 32;π PaletteOut[128+Counter1].Green := ((PaletteOut[Counter1].Green* 8)+π (0 * 24)) DIV 32;π PaletteOut[128+Counter1].Blue := ((PaletteOut[Counter1].Blue* 8)+π (26 * 24)) DIV 32;π PaletteOut[32+64+Counter1].Red := ((PaletteOut[Counter1].Red* 6)+π (23 * 26)) DIV 32;π PaletteOut[32+64+Counter1].Green := ((PaletteOut[Counter1].Green* 6)+π (23 * 26)) DIV 32;π PaletteOut[32+64+Counter1].Blue := ((PaletteOut[Counter1].Blue* 6)+π (0 * 26)) DIV 32;π PaletteOut[32+128+Counter1].Red := ((PaletteOut[Counter1].Red* 6)+π (23 * 26)) DIV 32;π PaletteOut[32+128+Counter1].Green := ((PaletteOut[Counter1].Green* 6)+π (0 * 26)) DIV 32;π PaletteOut[32+128+Counter1].Blue := ((PaletteOut[Counter1].Blue* 6)+π (23 * 26)) DIV 32;π PaletteOut[64+128+Counter1].Red := ((PaletteOut[Counter1].Red* 6)+π (0 * 26)) DIV 32;π PaletteOut[64+128+Counter1].Green := ((PaletteOut[Counter1].Green* 6)+π (23 * 26)) DIV 32;π PaletteOut[64+128+Counter1].Blue := ((PaletteOut[Counter1].Blue* 6)+π (23 * 26)) DIV 32;π End;πEnd;π{-[ Move Background by Moving Palette ]------------------------------------}πProcedure MoveBackground (Var PaletteIn : PaletteType);πVar TempPal : Array[0..5] of PaletteRec;πBeginπ {-- Move Background Colors --}π Move (PaletteIn[1], TempPal[0], 5 * 3);π Move (PaletteIn[1+5], PaletteIn[1], ((5 * 4) * 3));π Move (TempPal[0], PaletteIn[1 + (5 * 4)], 5 * 3);π {-- Move See-Through Colors --}π { Red }π Move (PaletteIn[32], TempPal[0], 6 * 3);π Move (PaletteIn[32+5], PaletteIn[32], ((5 * 4) * 3));π Move (TempPal[0], PaletteIn[32 + (5 * 4)], 6 * 3);π { Green }π Move (PaletteIn[64], TempPal[0], 6 * 3);π Move (PaletteIn[64+5], PaletteIn[64], ((5 * 4) * 3));π Move (TempPal[0], PaletteIn[64 + (5 * 4)], 6 * 3);π { Blue }π Move (PaletteIn[128], TempPal[0], 6 * 3);π Move (PaletteIn[128+5], PaletteIn[128], ((5 * 4) * 3));π Move (TempPal[0], PaletteIn[128 + (5 * 4)], 6 * 3);π { Red + Green }π Move (PaletteIn[(32 OR 64)], TempPal[0], 6 * 3);π Move (PaletteIn[(32 OR 64)+5], PaletteIn[(32 OR 64)], ((5 * 4) * 3));π Move (TempPal[0], PaletteIn[(32 OR 64) + (5 * 4)], 6 * 3);π { Red + Blue }π Move (PaletteIn[(32 OR 128)], TempPal[0], 6 * 3);π Move (PaletteIn[(32 OR 128)+5], PaletteIn[(32 OR 128)], ((5 * 4) * 3));π Move (TempPal[0], PaletteIn[(32 OR 128) + (5 * 4)], 6 * 3);π { Green + Blue }π Move (PaletteIn[(64 OR 128)], TempPal[0], 6 * 3);π Move (PaletteIn[(64 OR 128)+5], PaletteIn[(64 OR 128)], ((5 * 4) * 3));π Move (TempPal[0], PaletteIn[(64 OR 128) + (5 * 4)], 6 * 3);πEnd;π{-[ Set Palette ]----------------------------------------------------------}πProcedure SetPalette (Var PaletteIn : PaletteType); Assembler;πASMπ PUSH DSπ LDS SI, PaletteIn { Sets whole palette at once... }π MOV CX, 256 * 3 { *NOT* good practice since many VGA }π MOV DX, 03DAh { cards will show snow at the top of }π @WaitNotVSync: { of the screen. It's done here }π IN AL, DX { 'cause the background animation }π AND AL, 8 { requires large ammounts of the }π JNZ @WaitNotVSync { palette to be updated every new }π @WaitVSync: { frame. }π IN AL, DXπ AND AL, 8π JZ @WaitVSyncπ XOR AX, AXπ MOV DX, 03C8hπ OUT DX, ALπ INC DXπ @PaletteLoop:π LODSBπ OUT DX, ALπ LOOP @PaletteLoopπ POP DSπEnd;π{=[ Main Program ]=========================================================}πVar Polygon1 : PolyHPtr;πBeginπ VGAMEM := Ptr($A000, $0000);π New (WorkPage);π New (BkgPage);π New (Palette);π New (PolyList);π ClearPolyList (PolyList^);π GoMode13h;π BuildBackground (BkgPage^);π BuildPalette (Palette^);π SetPalette (Palette^);π Polygon1 := Nil;π InitializePolygon (Polygon1, { Polygon List Head }π 0, 0, 60, { X, Y, Z of polygon }π 0, 0, 0); { Iniitial Roll, Pitch, Yaw }π AddFacet (Polygon1, { Polygon List Head }π 32, { Color }π -40, -40, 50, { One Corner of Polygon }π 40, -40, 50, { Second Corner of Polygon }π 40, 40, 50, { Third Corner of Polygon }π -40, 40, 50); { Last Corner of Polygon }π AddFacet (Polygon1,π 64,π -50, -40, -40,π -50, -40, 40,π -50, 40, 40,π -50, 40, -40);π AddFacet (Polygon1,π 128,π 40, -50, -40,π 40, -50, 40,π -40, -50, 40,π -40, -50, -40);π Repeatπ { Clear Workpage }π WorkPage^ := BkgPage^;π ClearPolyList (PolyList^);π DrawPolygon3D (Polygon1, { Polygon Definition }π WorkPage); { Work buffer }π MoveBackground (Palette^);π SetPalette (Palette^);π { Display Work Buffer }π VGAMEM^ := WorkPage^;π RotatePolygon (Polygon1,π 5, 10, 1);π Until Keypressed;π DisposePolygon (Polygon1);π Dispose (PolyList);π Dispose (Palette);π Dispose (BkgPage);π Dispose (WorkPage);π TextMode (C80);πEnd.π 29 08-24-9417:53ALL GARTH KRUMINS GRAPHICS ROUTINES SWAG9408 5 12 ╓ {here are some assembler routines for the 320x200x256 mode.}ππusesπ crt;ππPROCEDURE InitVGA; ASSEMBLER;πasmπ mov ax, 13hπ int 10hπend;ππPROCEDURE InitTEXT; ASSEMBLER;πasmπ mov ax, 03hπ int 10hπend;ππPROCEDURE PlotPixel1(X, Y: Word; Color: Byte); ASSEMBLER;πasmπ push esπ push diπ mov ax, Yπ mov bx, axπ shl ax, 8π shl bx, 6π add ax, bxπ add ax, Xπ mov di, axπ mov ax, $A000π mov es, axπ mov al, Colorπ mov es:[di], alπ pop diπ pop esπend;ππPROCEDURE PlotPixel2(X, Y : word; Color : byte);πbeginπ if (X<320) then if (Y<200) then mem[$A000: Y*320+X] := color;πend;πππPROCEDURE SetColor (ColorNo, Red, Green, Blue : byte);πbeginπ PORT[$3C8] := ColorNo;π PORT[$3C9] := Red;π PORT[$3C9] := Green;π PORT[$3C9] := Blue;πend;πππvarπ LoopX : word;π LoopY, R, G, B, i : byte;π Ky : char;ππBeginπ Randomize;π InitVGA;π for LoopY := 0 to 199 doπ beginπ for LoopX := 0 to 319 doπ PlotPixel1(LoopX, LoopY, random(255)+1);π end;π B := 0;π repeatπ G := random(63);π for R := 0 to 63 doπ beginπ Setcolor(random(255)+1, R, G, B);π inc(G, 1);π if G=64 then G := 0;π end;π for G := 63 downto 0 doπ R := random(63);π beginπ Setcolor(random(255)+1, R, G, B);π dec(R, 1);π if R=0 then R := 63;π end;π inc(B, random(10)-5);π if B>63 then B := random(63);π until keypressed;π Ky := readkey;π InitTEXT;πend.πππ 30 08-24-9417:54ALL RICH VERAA Save/Restore Graphics SWAG9408 =Σ3 11 ╓ ππProcedure GetImage (X1,Y1,X2,Y2:Integer;P:Pointer); assembler;πasmπ mov bx,320π push dsπ les di,Pππ mov ax,0A000hπ mov ds,axπ mov ax,Y1π mov dx,320π mul dxπ add ax,X1π mov si,axππ mov ax,X2π sub ax,X1π inc axπ mov dx,axπ stoswππ mov ax,Y2π sub ax,Y1π inc axπ stoswπ mov cx,axππ @@1:π mov cx,dxππ shr cx,1π cldπ rep movswππ test dx,1π jz @@2π movsbπ @@2:π add si,bxπ sub si,dxππ dec axπ jnz @@1ππ pop dsπend;ππProcedure PutImage (X1,Y1:Integer;P:Pointer); assembler;πasmπ mov bx,320π push dsπ lds si,Pππ mov ax,0A000hπ mov es,axπ mov ax,Y1π mov dx,320π mul dxπ add ax,X1π mov di,axππ lodswπ mov dx,axππ lodswππ @@1:π mov cx,dxππ shr cx,1π cldπ rep movswππ test dx,1π jz @@2π movsbπ @@2:π add di,bxπ sub di,dxππ dec axπ jnz @@1ππ pop dsπend;ππProcedure Init;πbeginπ GetMem (Buf1,64000);π GetMem(Buf2,64000);πend;ππbeginπ init;π dographicstuff;ππ GetImage( 0,0,319,199,Buf1); {store page 1}ππ domoregraphicstuff;ππ GetImage( 0,0,319,199,Buf2); {store page 2}ππ PutImage (0,0, Buf1); {restore page 1}ππend.π 31 08-24-9417:55ALL LUIS MEZQUITA X3dunit SWAG9408 w¼è 78 ╓ unit x3dunit2;ππ{ mode-x 3D unit - xhlin-procedure by Sean Palmer }π{ Optimized by Luis Mezquita Raya }ππ{$g+}ππinterfaceππconst vidseg:word=$a000;π divd:word=128;π dist:word=200;π minx:word=0;π maxx:word=319;π border:boolean=false;ππvar ctab:array[byte] of integer;π stab:array[byte] of integer;π address:word;π triangles:boolean;ππProcedure setborder(col:byte);πProcedure setpal(c,r,g,b:byte);πProcedure retrace;πProcedure setmodex;πProcedure setaddress(ad:word);πProcedure cls;πProcedure polygon(x1,y1,x2,y2,x3,y3,x4,y4:integer; c:byte);πFunction cosinus(i:byte):integer;πFunction sinus(i:byte):integer;ππimplementationππvar xpos:array[0..199,0..1] of integer;ππProcedure setborder(col:byte); assembler;πasmπ xor ch,chπ mov cl,borderπ jcxz @outπ mov dx,3dahπ in al,dxπ mov dx,3c0hπ mov al,11h+32π out dx,alπ mov al,colπ out dx,alπ@out:πend;ππProcedure setpal(c,r,g,b:byte); assembler;πasmπ mov dx,3c8hπ mov al,[c]π out dx,alπ inc dxπ mov al,[r]π out dx,alπ mov al,[g]π out dx,alπ mov al,[b]π out dx,alπend;ππProcedure retrace; assembler;πasmπ mov dx,3dah;π@vert1: in al,dxπ test al,8π jz @vert1π@vert2: in al,dxπ test al,8π jnz @vert2πend;ππProcedure setmodex; assembler;πasmπ mov ax,13hπ int 10hπ mov dx,3c4hπ mov ax,0604hπ out dx,axπ mov ax,0f02hπ out dx,axπ mov cx,320*200π mov es,vidsegπ xor ax,axπ mov di,axπ rep stoswπ mov dx,3d4hπ mov ax,0014hπ out dx,axπ mov ax,0e317hπ out dx,axπend;ππProcedure setaddress(ad:word); assembler;πasmπ mov dx,3d4hπ mov al,0chπ mov ah,[byte(ad)+1]π out dx,axπ mov al,0dhπ mov ah,[byte(ad)]π out dx,axπend;ππProcedure cls; assembler;πasmπ mov es,vidsegπ mov di,addressπ mov cx,8000π mov dx,3c4hπ mov ax,0f02hπ out dx,axπ xor ax,axπ rep stoswπend;ππ{$f-}ππProcedure polygon(x1,y1,x2,y2,x3,y3,x4,y4:integer; c:byte); assembler;πvar mny,mxy,y,m,mult,divi,top,s,π stb,px1,py1,px2,py2:integer;π dir:byte;πasm { Procedure Polygon }π mov ax,y1 { Determine lowest & highest points }π mov cx,axπ mov bx,y2ππ cmp ax,bx { if mny>y2 ==> mny:=y2 }π jl @p2π mov ax,bxππ@p2: cmp cx,bx { if mxy<y2 ==> mxy:=y2 }π jg @p3π mov cx,bxππ@p3: mov bx,y3π cmp ax,bx { if mny>y3 ==> mny:=y3 }π jl @p3Mπ mov ax,bxππ@p3M: cmp cx,bx { if mxy<y3 ==> mxy:=y3 }π jg @p4π mov cx,bxππ@p4: mov bx,y4π cmp ax,bx { if mny>y4 ==> mny:=y4 }π jl @p4Mπ mov ax,bxππ@p4M: cmp cx,bx { if mxy<y4 ==> mxy:=y4 }π jg @vertπ mov cx,bxππ@vert: cmp ax,0 { Vertical range checking }π jge @minin { if mny<0 ==> mny:=0 }π xor ax,axπ@minin: cmp cx,200 { if mxy>199 ==> mxy:=199 }π jl @maxinπ mov cx,199π@maxin: cmp cx,0 { if mxy<0 ==> Exit }π jl @pexitπ cmp ax,199 { if mny>199 ==> Exit }π jg @pexitππ mov mny,ax { ax=mny=lowest point }π mov mxy,cx { cx=mxy=highest point }ππ push x1 { RangeChk(x1,y1,x2,y2) }π push y1π push x2π push y2π call @Rangeππ push x2 { RangeChk(x2,y2,x3,y3) }π push y2π push x3π push y3π call @Rangeππ push x3 { RangeChk(x3,y3,x4,y4) }π push y3π cmp Triangles,0π jz @Poly4π push x1π push y1π jmp @Lastππ@Poly4: push x4π push y4π call @Rangeππ push x4 { RangeChk(x4,y4,x1,y1) }π push y4π push x1π push y1π@Last: call @Rangeππ mov ax,mny { Show a poly }π mov di,ax { y:=mny }π shl di,2π lea bx,xposπ add di,bx { di points to xpos[y,0] }π@Show: mov y,ax { repeat ... }π mov cx,[di]π mov dx,[di+2]π mov px1,cxπ mov px2,dxπ push axπ push diπ call @xhlin { xhlin(px1,px2,y,c) }π pop diπ pop axπ add di,4 { Next xpos }π inc ax { inc(y) }π cmp ax,mxy { ... until y>mxy; }π jle @Showπ jmp @pexitππ{ RangeChk }ππ@Range: pop di { Get return IP }π pop py2 { Get params }π pop px2π pop py1π pop px1π push di { Save return IP }ππ mov ax,py1 { dir:=byte(y1<y2) }π cmp ax,py2π mov ax,1π jl @Rdwnπ dec alπ@Rdwn: mov dir,alππ shl al,1π push axπ shl al,2π sub ax,4π mov stb,ax { stb:=8*dir-4 }π pop axπ dec ax { s:=2*dir-1 }π mov s,ax { Check directions (-1= down, 1=up) }ππ test AH,10000000b { Calculate constants }π mov dx,0π jz @Rposiπ dec dxπ@Rposi: mov bx,px2π sub bx,px1π imul bxπ mov mult,ax { mult:=s*(x2-x1) }π mov ax,py2π mov bx,py1π mov cx,axπ sub ax,bxπ mov divi,ax { divi:=y2-y1 }ππ cmp bx,cx { ¿y1=y2? }ππ pushf { Calculate pointer to xpos[y,dir] }π mov y,bx { y:=y1 }π mov di,bxπ shl di,2π lea bx,xposπ add di,bxπ mov cl,dirπ mov ch,0π shl cl,1π add di,cx { di points to xpos[y,dir] }π popfππ je @Requ { if y1=y2 ==> @Requ }ππ mov m,0 { m:=0 }π mov ax,py2π add ax,sπ mov top,ax { top:=y2+s }ππ@RLoop: mov ax,y { repeat ... }π cmp ax,mny { if y<mny ==> @RNext }π jl @RNextπ cmp ax,mxy { if y>mxy ==> @RNext }π jg @RNextππ mov ax,m { Calculate int(m/divi)+x1 }π test AH,10000000bπ mov dx,0π jz @RLposπ dec dxπ@RLpos: mov bx,diviπ idiv bxπ add ax,px1π call @HR { HorRangeChk(m div divi+x1) }ππ@RNext: mov ax,multπ add m,ax { inc(m,mult) }π add di,stb { Next xpos }π mov ax,y { inc(y,s) }π add ax,sπ mov y,axπ cmp ax,topπ jne @RLoop { ... until y=top }π jmp @Rexitππ@Requ: mov ax,yπ cmp ax,mny { if y<mny ==> Exit }π jl @Rexitπ cmp ax,mxy { if y>mxy ==> Exit }π jg @Rexitπ mov ax,px1π call @HR { HorRangeChk(px1) }π@Rexit: jmp @exitππ{ HorRangeChk }ππ@HR: mov bx,minx { bx:=minx }π cmp ax,bxπ jl @HRsavπ mov bx,maxx { bx:=maxx }π cmp ax,bxπ jg @HRsavπ mov bx,axπ@HRsav: mov [di],bx { xpos[y,dir]:=bx }π jmp @exitπ{ xhlin }ππ@xhlin: mov es,vidsegπ cldπ mov ax,80π mul yπ mov di,ax { base of scan line }π add di,addressππ mov bx,px1 { px1 = x begin coord }π mov dx,px2 { px2 = x end coord }π cmp bx,dxπ jb @skipπ xchg bx,dx { switch coords if px1>px2 }ππ@skip: mov cl,blπ shr bx,2π mov ch,dlπ shr dx,2π and cx,$0303π sub dx,bx { width in Bytes }π add di,bx { offset into video buffer }π mov ax,$ff02π shl ah,clπ and ah,1111b { left edge mask }π mov cl,chπ mov bh,$f1π rol bh,clπ and bh,1111b { right edge mask }π mov cx,dxπ or cx,cxπ jnz @leftπ and ah,bh { combine left & right bitmasks }ππ@left: mov dx,$03c4π out dx,axπ inc dxπ mov al,cπ stosbπ jcxz @exitπ dec cxπ jcxz @rightπ mov al,1111bπ out dx,al { skipped if cx=0,1 }π mov al,cπ repz stosb { fill middle Bytes }ππ@right: mov al,bhπ out dx,al { skipped if cx=0 }π mov al,cπ stosbππ@exit: pop axπ push csπ push axπ retπ@pexit:πend;ππ{$f+}ππFunction cosinus(i:byte):integer;πbeginπ cosinus:=ctab[i];πend;ππFunction sinus(i:byte):integer;πbeginπ sinus:=stab[i];πend;ππProcedure Initialize;πvar i:byte;πbeginπ triangles:=False;π for i:=0 to 255 do ctab[i]:=round(-cos(i*pi/128)*divd);π for i:=0 to 255 do stab[i]:=round(sin(i*pi/128)*divd);πend;ππbeginπ Initialize;πend.π 32 08-24-9417:56ALL ANDREW GOLOVIN X-mode Write Mode ExampleSWAG9408 äΦ¼ù 31 ╓ π{ Illustration on how VGA Write Mode 1 works }π{ by Andrew Golovin (2:5080/10@Fidonet) }π{ Can be used at your own risk freely w/o }π{ any charge }π{============================================}π{ PREFACE: }π{ This example illustrate posibility to save }π{ Bitmaps in unused VRam. And use VWM1 to }π{ restore it by 4 pixels at one byte }π{ Use arrows to move "bitmap" on screen. }π{ This example _only_ illustrate this mode }π{ Extremly needs optimization! Don't use it }π{ as is. Just an idea. }ππUses CRT;πvarπ OldMode: Byte;ππprocedure SetWriteMode(Wmode: Byte); assembler;πasmπ Mov DX,3cehπ Mov AL,5π Out DX,ALπ Inc DXπ In AL,DXπ And AL,11111100bπ Or AL,WModeπ Out DX,ALπend;ππprocedure Init320x200_X; assembler;πasmπ Mov AH,0fh; Int 10h; Mov [OldMode],al; Mov AX,13h; Int 10h;π Mov DX,3c4h; Mov AL,04h; Out DX,AL; Inc DX; In AL,DX; And AL,011110111b;π Or AL,000000100b; Out DX,AL; Dec DX; Mov AX,0f02h; Out DX,AX;π Mov AX,0a000h; Mov ES,AX; XOr DI,DI; Mov AX,0202h; Mov CX,8000h;π ClD; RepNZ StoSW; Mov DX,3d4h; Mov AL,14h; Out DX,AL; Inc DX;π In AL,DX; And AL,010111111b; Out DX,AL; Dec DX; Mov AL,017h;π Out DX,AL; Inc DX; In AL,DX; Or AL,01000000b; Out DX,AL; Mov DX,3d4h;π Mov AX,80; ShR AX,1; Mov AH,AL; Mov AL,13h; Out DX,AX; Retπend;ππProcedure PutPixel(x,y: Word; c: Byte);π beginπ asmπ Mov DX,3c4hπ Mov AL,02π Out DX,ALπ Mov AX,Yπ ShL AX,4π Mov DI,AXπ ShL AX,2π Add DI,AXπ Mov AX,Xπ ShR AX,2π Add DI,AXπ Mov AX,Xπ And AX,3π Mov CL,ALπ Mov AL,1π ShL AL,CLπ Inc DXπ Out DX,ALπ Mov AX,0a000hπ Mov ES,AXπ Mov AL,Cπ StoSBπ end;π end;ππprocedure MaskBits(BitsToMask: Byte); assembler;π asmπ Mov DX,3cehπ Mov AL,8π Mov AH,BitsToMaskπ Out DX,AXπ end;ππProcedure MaskPlanes(PlaneToMask: Byte); assembler;πasmπ Mov DX,3c4hπ Mov AL,2π Out DX,ALπ Inc DXπ Mov AL,PlaneToMaskπ Out DX,ALπEnd;ππProcedure StoreBack(x,y,w,h: word; toAddr: word);π varπ curx,cury: Word;π beginπ SetWriteMode(1);π MaskPlanes($f);π MaskBits($ff);π For CurY:=Y to Y+H doπ Move(Mem[$a000:CurY*80+x],Mem[$a000:toAddr+(CurY-Y)*W],w);π SetWriteMode(0);π end;ππProcedure RestoreBack(x,y,w,h: word; fromAddr: Word);π varπ cury,curx: Word;π beginπ SetWriteMode(1);π MaskPlanes($f);π MaskBits($ff);π For CurY:=Y to Y+H doπ Move(Mem[$a000:fromAddr+(CurY-Y)*W],Mem[$a000:CurY*80+x],w);π SetWriteMode(0);π end;ππvarπ x,y: Word;π curx,cury: Word;π c: Char;πBeginπ Init320x200_x;π For x:=0 to 319 doπ For y:=0 to 199 doπ PutPixel(x,y,(x +y) mod 16+16);π StoreBack(0,0,3,12,16000);π For x:=0 to 11 doπ For y:=0 to 11 doπ PutPixel(x,y,Random(255));π StoreBack(0,0,3,12,16200);π CurX:=0;CurY:=0;π Repeatπ Repeat Until KeyPressed;π c:=ReadKey;π If c=#0π thenπ beginπ RestoreBack(CurX,CurY,3,12,16000);π c:=ReadKey;π Case c ofπ #80: If CurY<187π thenπ Inc(CurY);π #72: If CurY>0π Thenπ Dec(CurY);π #75: If CurX>0π Thenπ Dec(CurX);π #77: If CurX<77π Thenπ Inc(CurX);π end;π StoreBack(CurX,CurY,3,12,16000);π RestoreBack(CurX,CurY,3,12,16200);π end;π Until c=#27;π asm Mov al,OldMode; XOr AH,AH; Int 10h end;πEnd.ππ 33 08-25-9409:07ALL KIMMO K K FREDRIKSSON Fastest Putpixel? SWAG9408 Ö║3 22 ╓ (*πFrom: kfredrik@cc.Helsinki.FI (Kimmo K K Fredriksson)ππ: > This routine, from off the net somewhere, is a little fasterπ: > than simply writing to MEM (it replaces the multiply by aπ: > shift).π: Wilbert van Leijen and I once wrote a similar thing like this as an InLineπ: macro, which turned out to be the true fastest code (ok, never say...)ππ: Procedure PutPixel18(c: Byte; x,y: Integer);π: Inline(π: $B8/$00/$A0/ { mov AX,$A000 }π: $8E/$C0/ { mov ES,AX }π: $5B/ { pop BX }π: $88/$DC/ { mov AH,BL }π: $5F/ { pop DI }π: $01/$C7/ { add DI,AX }π: {$IFOPT G+}π: $C1/$E8/$02/ { shr AX,2 }π: {$ELSE}π: $D1/$E8/ { shr AX,1 }π: $D1/$E8/ { shr AX,1 }π: {$ENDIF}π: $01/$C7/ { add DI,AX }π: $58/ { pop AX }π: $AA); { stosb }ππ: I'd be real interested in seeing a PutPixel (remember: one pixel only, not aπ: line, that's another story) that is faster than this one...ππThis is fast indeed, but the last instruction should be replaced atπleast in 486 and Pentium CPUs with instruction mov es:[di],al, whichπis faster than stosb (and you may also want to re-arrange them).ππAlso, the shift and add sequence could be replaced by table look-up,πbut that wouldn't be so elegant, only faster. So if you wanna stickπwith arithmetic address calculation, you could use 32-bit instructions,πsomething like this:ππ mov es,[SegA000]π pop diπ pop bxπ pop axπ shl di,6π lea edi,[edi*4+edi]π mov es:[edi+ebx],alπ πIf I use 32-bit instructions, I usually zero data registers in theπinitialization part of my program, so I can use those registersπin the situations like above without the need to every time zeroπthe high bits.ππYou may also use fs or gs register instead of es, because you mayπalways keep it pointing to video RAM, instead of loading it everyπtime you do PutPixel.ππThis may go beyond the topic, but what the heck: usually I try toπuse the offset of the screen mem as the parameter of these kind ofπprocedures, because it removes the need of address calculation:π*)πPROCEDURE PutPixel( offset : Word; c : Byte );π INLINE(π pop axπ pop diπ mov fs,[di],alπ);π(*πIt is still very easy to use the offset instead of the (x,y)πposition, if you want the next x-pix, add one to offset, ifπyou want the next y-pix, add 320 to offset.ππSorry, but I was too lazy to calc the hex values :-(ππAnd never say that you have the absolutely fastest code ;-)π*)π 34 08-25-9409:08ALL YUAN LIU Virtual world plotting SWAG9408 -G 38 ╓ {πFrom: yliu@morgan.ucs.mun.ca (Yuan Liu)ππ: I have a question for drawing a graphic. I have a set of data.π: I want to read these data and plot them in the XY axes. Does anyoneπ: know how to caculate the data to fit the X axis. I am using TP 7.0.ππWhen converting from HP Pascal, which provides a nice subset of theπdevice-independent graphics kernal and allows plotting in the virtual worldπ(so the window and viewport can be set in the virtual world), I wroteπseveral procedures to simulate virtual world plotting. The following isπpart of a unit Plotbase I created.ππThe function you needed is set_window; the boolean pagefit controlsπwhether you just want your plot to fit in the whole window or there's a concernπabout the isotropy of the plot. I didn't bother to write a virtualπworld set_viewport as I can live without it.ππ}πUNIT PLOTBASE; {******************* Stored in 'PLOTBASE' ******************}π{* Basic procedures for graphical manipulations. *}π{* Created in 1983. Updated 17/05/94 10:00 a.m. By LIU Yuan *}π{**************************************************************************}πinterface USES Graph;πprocedure set_window(left, right, up, down: extended; pagefit: boolean);π {Sets a mapping of virtual window on the current viewport;π use isotropic scaling if not pagefit.}πfunction vToX(x: extended): integer;πfunction vToY(y: extended): integer;π {Map x, y in the virtual world onto real world}πfunction XtoV(X: integer): extended;πfunction YtoV(Y: integer): extended;π {Maps X, Y in the real world onto virtual world}π use isotropic scaling if not pagefit.πprocedure vMove(x, y: extended);π {Moves the current position to (x,y) in the virtual world}πprocedure vMoveRel(Dx, Dy: extended);π{Moves the current position a relative distance in the virtual world}πprocedure vLine(x1, y1, x2, y2: extended);π {Draws a line from (x1,y1) to (x2,y2) in the virtual world}πprocedure vLineTo(x, y: extended);π {Draws a line from current position to (x,y) in the virtual world}πfunction str_width(str: string): extended; {string width in the virtual world}πfunction str_height(str: string): extended; {string height in the virtualπworld}πimplementation {************************** PLOTBASE *************************}π var Text: string[20];π xasp, yasp, xbase, ybase: extended;π {convert from virtual world to display}ππprocedure set_window(left, right, up, down: extended; pagefit: boolean);π {Sets a mapping of virtual window on the current viewport;π use isotropic scaling if not pagefit.π Side effects: xasp, yasp, xbase, ybase.}πvar view: ViewPortType;πbegin xbase:=left; ybase:=down; right:=right-left; up:=up-down;π GetViewSettings(view);π right:=(view.x2-view.x1)/right;π up:=(view.y2-view.y1)/up;π if pagefit then begin xasp:=right; yasp:=up endπ else if right<up then begin yasp:=right; xasp:=right; endπ else begin xasp:=up; yasp:=up endπend; {set_window}ππfunction vToX(x: extended): integer;begin vToX:=round((x-xbase)*xasp) end;π {Maps x in the virtual world onto real world}πfunction vToY(y: extended): integer;begin vToY:=round((y-ybase)*yasp) end;π {Maps x in the virtual world onto real world}ππfunction XtoV(X: integer): extended; begin XtoV:=X/xasp+xbase end; {XtoV}π {Maps X in the real world onto virtual world}πfunction YtoV(Y: integer): extended; begin YtoV:=Y/yasp+ybase end; {YtoV}π {Maps Y in the real world onto virtual world}ππprocedure vMove(x, y: extended);π {Moves the current position to (x,y) in the virtual world}πbegin MoveTo(round((x-xbase)*xasp),round((y-ybase)*yasp)) end; {vMove}πprocedure vMoveRel(Dx, Dy: extended);π{Moves the current position a relative distance in the virtual world}πbegin MoveRel(round(Dx*xasp),round(Dy*yasp)) end; {vMoveRel}ππprocedure vLine(x1, y1, x2, y2: extended);π {Draws a line from (x1,y1) to (x2,y2) in the virtual world}πbegin line(round((x1-xbase)*xasp),round((y1-ybase)*yasp),π round((x2-xbase)*xasp),round((y2-ybase)*yasp)) end; {vLine}ππprocedure vLineTo(x, y: extended);π {Draws a line from current position to (x,y) in the virtual world}πbegin LineTo(round((x-xbase)*xasp),round((y-ybase)*yasp)) end; {vLineTo}ππfunction str_width(str: string): extended; {string width in the virtual world}πbegin str_width:=TextWidth(str)/xasp end; {str_width}ππfunction str_height(str: string): extended; {string height in the virtualπworld}πbegin str_height:=TextHeight(str)/yasp end; {str_height}π 35 08-25-9409:11ALL MIKE CHURCH Stars AGAIN!!!! SWAG9408 ëcè╛ 31 ╓ {πOk... Here goes. You will have to figure out how to TSR this if youπwant... But you can navigate in this one too! TP v6.0π}ππprogram stars;π{$R-}π{$S-} {dangerous, but it's pretty well debugged}π{$G+}πuses crt;πconst MaxStars=1000; { OK for 486-33. Decrease for slower computers}π xltsin:integer=0;π xltcos:integer=round((1-(640/32767)*(640/32767))*32767);π yltsin:integer=0;π yltcos:integer=round((1-(640/32767)*(640/32767))*32767);π zltsin:integer=0;π zltcos:integer=round((1-(640/32767)*(640/32767))*32767);π {rotation parameters, 16-bit.}π speed:word=264; {speed of movement thru starfield}πconst XWIDTH = 320; { basic screen size stuff used for star animation.}πconst YWIDTH = 200;πconst XCENTER = ( XWIDTH div 2 );πconst YCENTER = ( YWIDTH div 2 );πtype STARtype=recordπ x,y,z:integer; {The x, y and z coordinates}π xz,yz:integer; { screen coords}π end;πvar star:array[1..maxstars] of startype;π i:integer;π ch:char;π rotx,roty,rotz:boolean;π rotxv,rotyv,rotzv:integer;πprocedure setmode13; {sets 320*200 256-colour mode}πassembler;πasmπ mov ax,13hπ int 10hπend;πprocedure settextmode; {returns to text mode}πassembler;πasmπ mov ax,03hπ int 10hπend;πprocedure setpix(x,y:integer;c:byte); {NO BOUNDARY CHECKING!}πbegin {Sets a pixel in mode 13h}πasmπ mov ax,0a000hπ mov es,axπ mov ax,yπ mov bx,320π mul bxπ mov di,xπ add di,axπ mov al,cπ mov es:[di],alπend;πend;πprocedure initstar(i:integer); {initialise stars at random positions}πbeginπ with star[i] doπ beginπ x := longint(-32767)+random(65535);π y := longint(-32767)+random(65535); {at rear}π z := random(16000)+256;π xz:=xcenter;π yz:=ycenter;π end;πend;πprocedure newstar(i:integer); {create new star at either front or}πbegin {rear of starfield}π with star[i] doπ beginπ x := longint(-32767)+random(65535);π y := longint(-32767)+random(65535);π if z<256 then z := random(1256)+14500 {kludgy, huh?}π else z:=random(256)+256;π xz:=xcenter;π yz:=ycenter;π end;πend;ππ{$L update.obj}πprocedure update(var star:startype;i:integer);external;πππππbeginπ {gets ~100 frames/sec on a 486-33 with 500 stars,π rotating on 1 axis, speed 256}π clrscr;π checkbreak:=false; { for speed?}π randomize;π for i:=1 to maxstars do initstar(i); {initialise stars}π setmode13;π rotx:=true;roty:=true;rotz:=true;π ch:=' ';π repeatπ for i:=1 to maxstars do update(star[i],i); {update star positions}π if keypressed thenπ beginπ ch:=readkey; { change parameters according to }π if ch='+' then speed:=speed+32; { key pressed}π if ch='-' then speed:=speed-32;π if ch=#13 thenπ beginπ xltsin:=0;π yltsin:=0;π zltsin:=0;π speed:=256;π end;π if ch=#80 then dec(xltsin,96);π if ch=#72 then inc(xltsin,96);π if ch=#77 then dec(yltsin,96);π if ch=#75 then inc(yltsin,96);π if ch=#81 thenπ beginπ dec(yltsin,96);π if xltsin<0 then inc(zltsin,96);π if xltsin>0 then dec(zltsin,96);π end;π if ch=#79 thenπ beginπ inc(yltsin,96);π if xltsin<0 then dec(zltsin,96);π if xltsin>0 then inc(zltsin,96);π end;π if ch=#71 then dec(zltsin,96);π if ch=#73 then inc(zltsin,96);π end;π xltcos:=round((1-sqr(xltsin/32767))*32767);π yltcos:=round((1-sqr(yltsin/32767))*32767); { evaluate cos values}π zltcos:=round((1-sqr(zltsin/32767))*32767);π until ch=#27; {hit ESC to exit}π settextmode;π writeln;πend.π 36 08-25-9409:11ALL BOB SCHOR Storing 3D Graphics SWAG9408 ╖Me∞ 27 ╓ {πFrom: Bschor@vms.cis.pitt.eduππ> Now the problem. "Seek(F, I)" will only take ONE integer at a time!!π> Naturally I need two. I'm trying to run it so that at each virtualπ> "square" a user can define a different message, monster, etc. And theπ> file i'm writing to must be able to define between X & Y, [(1,2) forπ> example], or both of them togeter [E.G. Two steps to the right, two stepsπ> forward = (2,2)]. HOW DO I DO THIS???ππIf I understand the question correctly, you are asking how to map aπtwo-dimensional structure (a 2-D map of your world) into a 1-dimensionalπdata structure (a file). Ah, my ancient Fortran knowledge does come inπuseful ...ππThe following works for arrays of any dimension, though you need toπhave the array size fixed. Suppose you have dimensioned World into R rows,πC columns, and L layers (I'm doing 3-D, just to show how it can be done).πTo make it all very clear, I'll define the world as either a 3-D or linearπstructure, using the Pascal Variant Record type.π}ππCONSTπ rows = 30;π columns = 40;π layers = 5;π rooms = 6000; { rows * columns * layers }πTYPEπ rowtype = 1 .. rows;π columntype = 1 .. columns;π layertype = 1 .. layers;π roomnumbertype = 1 .. rooms;π roomtype = RECORDπ { you define as needed }π END;π worldtype = RECORDπ CASE (d3, d1) ofπ d3 : (spatial: ARRAY [layertype, rowtype, columntype] OF roomtype);π d1 : (linear : ARRAY [roomnumbertype] OF roomtype);π END;π{π Basically, you determine an order you wish to store the data. Supposeπyou say "Start with the first layer, the first row, the first column.πMarch across the columns, then move down a row and repeat across theπcolumns; when you finish a layer, move down to the next layer and repeat".ππ Clearly Layer 1, Row 1, Column C maps to Room C. Since each row hasπ"columns" columns, then the mapping of Layer 1, Row R, Column C is toπRoom (R-1)*columns + C. The full mapping is --π}π FUNCTION roomnumber (layer : layertype; row : rowtype;π column : columntype) : roomnumbertype;ππ BEGIN { roomnumber }π roomnumber := column + pred(row)*columns + pred(layer)*columns*rowsπ END;ππ{ Note you can also map in the other direction:}ππ FUNCTION layer (roomnumber : roomnumbertype) : layertype;ππ BEGIN { layer }π layer := succ (pred(roomnumber) DIV (columns * rows))π END;ππ FUNCTION row (roomnumber : roomnumbertype) : rowtype;ππ BEGIN { row }π row := succ ((pred(roomnumber) MOD (columns * rows)) DIV columns)π END;ππ FUNCTION column (roomnumber : roomnumbertype) : columntype;ππ BEGIN { column }π column := succ (pred(roomnumber) MOD columns)π END;ππ{π Putting it all together, suppose you have a room, "room", with roomπnumber "roomnumber", that you want to put into the world.π}π VAR world : worldtype;π room : roomtype;π roomnumber : roomnumbertype;ππ WITH world DOπ BEGINπ spatial[layer(roomnumber), row(roomnumber), column(roomnumber)] := roomπ END;π{π The above fragment stores a room into the three-dimensional world.πOf course, if you know the room number (which we do), you can also simplyπ}ππ WITH world DO linear[roomnumber] := roomπ{π For the original question, note that the "roomnumber" function givesπyou the record number for the Seek procedure (you may need to offset by 1,πdepending on how Seek is implemented ...).π}π
